maxLik/0000755000176200001440000000000013606005761011503 5ustar liggesusersmaxLik/NAMESPACE0000644000176200001440000000414212660520442012720 0ustar liggesusersexport( "activePar" ) export( "compareDerivatives" ) export( "condiNumber" ) export( "fnSubset" ) export( "gradient" ) export( "hessian" ) export( "maxBFGS" ) export( "maxBFGSR" ) export( "maxBHHH" ) export( "maxCG" ) export( "maximType" ) export( "maxValue" ) export( "maxLik" ) export( "maxNM" ) export( "maxNR" ) export( "maxSANN" ) export( "nIter" ) export( "numericGradient" ) export( "numericHessian" ) export( "numericNHessian" ) export( "objectiveFn" ) export( "returnCode" ) export( "returnMessage" ) export("sumt") importFrom("methods", "new", "show", "slot", "slot<-", "slotNames", "validObject") importFrom( "miscTools", "nObs" ) importFrom( "miscTools", "nParam" ) importFrom( "miscTools", "sumKeepAttr" ) importFrom( "sandwich", "bread" ) importFrom( "miscTools", "stdEr" ) importFrom( "sandwich", "estfun" ) importFrom("stats", "coef", "logLik", "optim", "pnorm", "printCoefmat", "vcov") importFrom("utils", "head", "str", "tail") exportClasses("MaxControl") exportMethods("maxControl") exportMethods("show") S3method( "activePar", "default" ) S3method( "AIC", "maxLik" ) S3method( "bread", "maxLik" ) S3method( "coef", "maxim" ) S3method( "coef", "maxLik" ) S3method( "coef", "summary.maxLik" ) S3method( "condiNumber", "default" ) S3method( "condiNumber", "maxLik" ) S3method( "estfun", "maxLik" ) S3method( "gradient", "maxim" ) S3method( "hessian", "default" ) S3method( "logLik", "maxLik" ) S3method( "logLik", "summary.maxLik" ) S3method( "maximType", "default" ) S3method( "maximType", "maxim" ) S3method( "maxValue", "maxim" ) S3method( "nIter", "default" ) S3method( "nObs", "maxLik" ) S3method( "nParam", "maxim" ) S3method( "print", "maxLik" ) S3method( "print", "summary.maxim" ) S3method( "print", "summary.maxLik" ) S3method( "objectiveFn", "maxim" ) S3method( "returnCode", "default" ) S3method( "returnCode", "maxim" ) S3method( "returnCode", "maxLik" ) S3method( "returnMessage", "default" ) S3method( "returnMessage", "maxim" ) S3method( "returnMessage", "maxLik" ) S3method( "stdEr", "maxLik" ) S3method( "summary", "maxim" ) S3method( "summary", "maxLik" ) S3method( "vcov", "maxLik" ) maxLik/man/0000755000176200001440000000000013603275533012261 5ustar liggesusersmaxLik/man/sumt.Rd0000644000176200001440000001231312612766327013545 0ustar liggesusers\name{sumt} \Rdversion{1.1} \alias{sumt} \title{ Equality-constrained optimization } \description{ Sequentially Unconstrained Maximization Technique (SUMT) based optimization for linear equality constraints. This implementation is primarily intended to be called from other maximization routines, such as \code{\link{maxNR}}. } \usage{ sumt(fn, grad=NULL, hess=NULL, start, maxRoutine, constraints, SUMTTol = sqrt(.Machine$double.eps), SUMTPenaltyTol = sqrt(.Machine$double.eps), SUMTQ = 10, SUMTRho0 = NULL, printLevel=print.level, print.level = 0, SUMTMaxIter = 100, ...) } \arguments{ \item{fn}{ function of a (single) vector parameter. The function may have more arguments (passed by \dots), but those are not treated as the parameter. } \item{grad}{ gradient function of \code{fn}. NULL if missing } \item{hess}{ function, Hessian of the \code{fn}. NULL if missing } \item{start}{ numeric, initial value of the parameter } \item{maxRoutine}{ maximization algorithm, such as \code{\link{maxNR}} } \item{constraints}{list, information for constrained maximization. Currently two components are supported: \code{eqA} and \code{eqB} for linear equality constraints: \eqn{A \beta + B = 0}{A \%*\% beta + B = 0}. The user must ensure that the matrices \code{A} and \code{B} are conformable.} \item{SUMTTol}{ stopping condition. If the estimates at successive outer iterations are close enough, i.e. maximum of the absolute value over the component difference is smaller than SUMTTol, the algorithm stops. Note this does not necessarily mean that the constraints are satisfied. If the penalty function is too \dQuote{weak}, SUMT may repeatedly find the same optimum. In that case a warning is issued. The user may set SUMTTol to a lower value, e.g. to zero. } \item{SUMTPenaltyTol}{ stopping condition. If the barrier value (also called penalty) \eqn{(A \beta + B)'(A \beta + B)}{t(A \%*\% beta + B) \%*\% (A \%*\% beta + B)} is less than \code{SUMTTol}, the algorithm stops } \item{SUMTQ}{ a double greater than one, controlling the growth of the \code{rho} as described in Details. Defaults to 10. } \item{SUMTRho0}{ Initial value for \code{rho}. If not specified, a (possibly) suitable value is selected. See Details. One should consider supplying \code{SUMTRho0} in case where the unconstrained problem does not have a maximum, or the maximum is too far from the constrained value. Otherwise the authomatically selected value may not lead to convergence. } \item{printLevel}{ Integer, debugging information. Larger number prints more details. } \item{print.level}{same as \sQuote{printLevel}, for backward compatibility} \item{SUMTMaxIter}{ Maximum SUMT iterations } \item{\dots}{ Other arguments to \code{maxRoutine} and \code{fn}. } } \details{ The Sequential Unconstrained Minimization Technique is a heuristic for constrained optimization. To minimize a function \eqn{f}{f} subject to constraints, it uses a non-negative penalty function \eqn{P}{P}, such that \eqn{P(x)}{P(x)} is zero iff \eqn{x}{x} satisfies the constraints. One iteratively minimizes \eqn{f(x) + \varrho_k P(x)}{f(x) + rho_k P(x)}, where the \eqn{\varrho}{rho} values are increased according to the rule \eqn{\varrho_{k+1} = q \varrho_k}{rho_{k+1} = q rho_k} for some constant \eqn{q > 1}{q > 1}, until convergence is achieved in the sense that the barrier value \eqn{P(x)'P(x)}{P(x)'P(x)} is close to zero. Note that there is no guarantee that the global constrained optimum is found. Standard practice recommends to use the best solution found in \dQuote{sufficiently many} replications. Any of the maximization algorithms in the \pkg{maxLik}, such as \code{\link{maxNR}}, can be used for the unconstrained step. Analytic gradient and hessian are used if provided. } \value{ Object of class 'maxim'. In addition, a component \item{constraints}{A list, describing the constrained optimization. Includes the following components: \describe{ \item{type}{type of constrained optimization} \item{barrier.value}{value of the penalty function at maximum} \item{code}{code for the stopping condition} \item{message}{a short message, describing the stopping condition} \item{outer.iterations}{number of iterations in the SUMT step} } } } \section{Note}{ In case of equality constraints, it may be more efficient to enclose the function in a wrapper function. The wrapper calculates full set of parameters based on a smaller set of parameters, and the constraints. } \author{ Ott Toomet, Arne Henningsen } \seealso{ \code{\link[clue]{sumt}} in package \pkg{clue}. } \examples{ ## We maximize exp(-x^2 - y^2) where x+y = 1 hatf <- function(theta) { x <- theta[1] y <- theta[2] exp(-(x^2 + y^2)) ## Note: you may prefer exp(- theta \%*\% theta) instead } ## use constraints: x + y = 1 A <- matrix(c(1, 1), 1, 2) B <- -1 res <- sumt(hatf, start=c(0,0), maxRoutine=maxNR, constraints=list(eqA=A, eqB=B)) print(summary(res)) } \keyword{optimize} maxLik/man/gradient.Rd0000644000176200001440000000371512660242202014340 0ustar liggesusers\name{gradient} \alias{gradient} \alias{gradient.maxim} \alias{estfun.maxLik} \title{Extract Gradients Evaluated at each Observation} \description{ Extract the gradients of the log-likelihood function evaluated at each observation (\sQuote{Empirical Estimating Function}, see \code{\link[sandwich]{estfun}}). } \usage{ \method{estfun}{maxLik}(x, ...) \method{gradient}{maxim}(x, ...) } \arguments{ \item{x}{an object inheriting from class \code{maxim} (for \code{gradient}) or \code{maxLik}. (for \code{estfun}.)} \item{\dots}{further arguments (currently ignored).} } \value{ \item{\code{gradient}}{vector, objective function gradient at estimated maximum (or the last calculated value if the estimation did not converge.)} \item{\code{estfun}}{ matrix, observation-wise log-likelihood gradients at the estimated parameter value evaluated at each observation. Observations in rows, parameters in columns.} } \section{Warnings}{ The \pkg{sandwich} package must be loaded in order to use \code{estfun}. \code{estfun} only works if the observaton-specific gradient information was available for the estimation. This is the case of the observation-specific gradient was supplied (see the \code{grad} argument for \code{\link{maxLik}}), or the log-likelihood function returns a vector of observation-specific values. } \author{ Arne Henningsen, Ott Toomet } \seealso{\code{\link{hessian}}, \code{\link[sandwich]{estfun}}, \code{\link{maxLik}}.} \examples{ ## ML estimation of exponential duration model: t <- rexp(10, 2) loglik <- function(theta) log(theta) - theta*t ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1 ) gradient(a) # Extract the gradients evaluated at each observation library( sandwich ) estfun( a ) ## Estimate with analytic gradient. ## Note: it returns a vector gradlik <- function(theta) 1/theta - t b <- maxLik(loglik, gradlik, start=1) gradient(a) estfun( b ) } \keyword{methods} maxLik/man/maxLik.Rd0000644000176200001440000001073012604626335013776 0ustar liggesusers\name{maxLik} \alias{maxLik} \alias{print.maxLik} \title{Maximum likelihood estimation} \description{ This is the main interface for the \pkg{maxLik} package, and the function that performs Maximum Likelihood estimation. It is a wrapper for different optimizers returning an object of class "maxLik". Corresponding methods handle the likelihood-specific properties of the estimates, including standard errors. } \usage{ maxLik(logLik, grad = NULL, hess = NULL, start, method, constraints=NULL, ...) } \arguments{ \item{logLik}{log-likelihood function. Must have the parameter vector as the first argument. Must return either a single log-likelihood value, or a numeric vector where each component is log-likelihood of the corresponding individual observation.} \item{grad}{gradient of log-likelihood. Must have the parameter vector as the first argument. Must return either a single gradient vector with length equal to the number of parameters, or a matrix where each row is the gradient vector of the corresponding individual observation. If \code{NULL}, numeric gradient will be used.} \item{hess}{hessian of log-likelihood. Must have the parameter vector as the first argument. Must return a square matrix. If \code{NULL}, numeric Hessian will be used.} \item{start}{numeric vector, initial value of parameters. If it has names, these will also be used for naming the results.} \item{method}{maximisation method, currently either "NR" (for Newton-Raphson), "BFGS" (for Broyden-Fletcher-Goldfarb-Shanno), "BFGSR" (for the BFGS algorithm implemented in \R), "BHHH" (for Berndt-Hall-Hall-Hausman), "SANN" (for Simulated ANNealing), "CG" (for Conjugate Gradients), or "NM" (for Nelder-Mead). Lower-case letters (such as "nr" for Newton-Raphson) are allowed. If missing, a suitable method is selected automatically.} \item{constraints}{either \code{NULL} for unconstrained maximization or a list, specifying the constraints. See \code{\link{maxBFGS}}. } \item{\dots}{further arguments, such as \code{control} are passed to the selected maximisation routine, i.e. \code{\link{maxNR}}, \code{\link{maxBFGS}}, \code{\link{maxBFGSR}}, \code{\link{maxBHHH}}, \code{\link{maxSANN}}, \code{\link{maxCG}}, or \code{\link{maxNM}} (depending on argument \code{method}). Arguments not used by the optimizers are forwarded to \code{logLik}, \code{grad} and \code{hess}.} } \details{ \code{maxLik} supports constrained optimization in the sense that constraints are passed further to the underlying optimization routines, and suitable default method is selected. However, no attempt is made to correct the resulting variance-covariance matrix. Hence the inference may be wrong. A corresponding warning is issued by the summary method. } \value{ object of class 'maxLik' which inherits from class 'maxim'. The structure is identical to that of the class \dQuote{maxim} (see \code{\link{maxNR}}) but the methods differ. } \section{Warning}{The constrained maximum likelihood estimation should be considered experimental. In particular, the variance-covariance matrix is not corrected for constrained parameter space. } \author{Ott Toomet, Arne Henningsen} \seealso{\code{\link{maxNR}}, \code{\link{nlm}} and \code{\link{optim}} for different non-linear optimisation routines, see \code{\link{maxBFGS}} for the constrained maximization examples.} \examples{ ## Estimate the parameter of exponential distribution t <- rexp(100, 2) loglik <- function(theta) log(theta) - theta*t gradlik <- function(theta) 1/theta - t hesslik <- function(theta) -100/theta^2 ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1, control=list(printLevel=2)) summary( a ) ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1) summary( a ) ## ## Next, we give an example with vector argument: Estimate the mean and ## variance of a random normal sample by maximum likelihood ## loglik <- function(param) { mu <- param[1] sigma <- param[2] ll <- -0.5*N*log(2*pi) - N*log(sigma) - sum(0.5*(x - mu)^2/sigma^2) ll } x <- rnorm(100, 1, 2) # use mean=1, stdd=2 N <- length(x) res <- maxLik(loglik, start=c(0,1)) # use 'wrong' start values summary( res ) ## ## The previous example showing parameter names and fixed values ## resFix <- maxLik(loglik, start=c(mu=0, sigma=1), fixed="sigma") summary(resFix) # 'sigma' is exactly 1.000 now. } \keyword{optimize} maxLik/man/objectiveFn.Rd0000644000176200001440000000145412660520442015004 0ustar liggesusers\name{objectiveFn} \alias{objectiveFn} \alias{objectiveFn.maxim} \title{Optimization Objective Function} \description{ This function returns the optimization objective function from a \sQuote{maxim} object. } \usage{ objectiveFn(x, \dots) \method{objectiveFn}{maxim}(x, \dots) } \arguments{ \item{x}{an optimization result, inheriting from class \sQuote{maxim}} \item{\dots}{other arguments for methods} } \value{ function, the function that was optimized. It can be directly called, given that all necessary variables are accessible from the current environment. } \author{Ott Toomet} \examples{ hatf <- function(theta) exp(- theta \%*\% theta) res <- maxNR(hatf, start=c(0,0)) print(summary(res)) print(objectiveFn(res)) print(objectiveFn(res)(2)) # 0.01832 } \keyword{methods} \keyword{optimize} maxLik/man/maximType.Rd0000644000176200001440000000144212604622732014523 0ustar liggesusers\name{maximType} \alias{maximType} \alias{maximType.default} \alias{maximType.maxim} \alias{maximType.MLEstimate} \title{Type of Minimization/Maximization} \description{ Returns the type of optimization as supplied by the optimisation routine. } \usage{ maximType(x) } \arguments{ \item{x}{object of class 'maxim' or another object which involves numerical optimisation. } } \value{ A text message, describing the involved optimisation algorithm } \author{Ott Toomet} \seealso{\code{\link{maxNR}}} \examples{ ## maximize two-dimensional exponential hat. True maximum c(2,1): f <- function(a) exp(-(a[1] - 2)^2 - (a[2] - 1)^2) m <- maxNR(f, start=c(0,0)) coef(m) maximType(m) ## Now use BFGS maximisation. m <- maxBFGS(f, start=c(0,0)) maximType(m) } \keyword{optimize} \keyword{methods} maxLik/man/numericGradient.Rd0000644000176200001440000000541512605102662015666 0ustar liggesusers\name{numericGradient} \alias{numericGradient} \alias{numericHessian} \alias{numericNHessian} \title{Functions to Calculate Numeric Derivatives} \description{ Calculate (central) numeric gradient and Hessian, including of vector-valued functions. } \usage{ numericGradient(f, t0, eps=1e-06, fixed, \dots) numericHessian(f, grad=NULL, t0, eps=1e-06, fixed, \dots) numericNHessian(f, t0, eps=1e-6, fixed, \dots) } \arguments{ \item{f}{function to be differentiated. The first argument must be the parameter vector with respect to which it is differentiated. For numeric gradient, \code{f} may return a (numeric) vector, for Hessian it should return a numeric scalar} \item{grad}{function, gradient of \code{f}} \item{t0}{vector, the parameter values} \item{eps}{numeric, the step for numeric differentiation} \item{fixed}{logical index vector, fixed parameters. Derivative is calculated only with respect to the parameters for which \code{fixed == FALSE}, \code{NA} is returned for the fixed parameters. If missing, all parameters are treated as active.} \item{\dots}{furter arguments for \code{f}} } \details{ \code{numericGradient} numerically differentiates a (vector valued) function with respect to it's (vector valued) argument. If the functions value is a \eqn{N_{val} \times 1}{\code{N_val * 1}} vector and the argument is \eqn{N_{par} \times 1}{\code{N_par * 1}} vector, the resulting gradient is a \eqn{N_{val} \times N_{par}}{\code{NVal * NPar}} matrix. \code{numericHessian} checks whether a gradient function is present. If yes, it calculates the gradient of the gradient, if not, it calculates the full numeric Hessian (\code{numericNHessian}). } \value{ Matrix. For \code{numericGradient}, the number of rows is equal to the length of the function value vector, and the number of columns is equal to the length of the parameter vector. For the \code{numericHessian}, both numer of rows and columns is equal to the length of the parameter vector. } \section{Warning}{ Be careful when using numerical differentiation in optimization routines. Although quite precise in simple cases, they may work very poorly in more complicated conditions. } \author{Ott Toomet} \seealso{\code{\link{compareDerivatives}}, \code{\link{deriv}}} \examples{ # A simple example with Gaussian bell surface f0 <- function(t0) exp(-t0[1]^2 - t0[2]^2) numericGradient(f0, c(1,2)) numericHessian(f0, t0=c(1,2)) # An example with the analytic gradient gradf0 <- function(t0) -2*t0*f0(t0) numericHessian(f0, gradf0, t0=c(1,2)) # The results should be similar as in the previous case # The central numeric derivatives are often quite precise compareDerivatives(f0, gradf0, t0=1:2) # The difference is around 1e-10 } \keyword{math} \keyword{utilities} maxLik/man/logLik.maxLik.Rd0000644000176200001440000000221212660242202015177 0ustar liggesusers\name{logLik.maxLik} \alias{logLik.maxLik} \alias{logLik.summary.maxLik} \title{Return the log likelihood value} \description{ Return the log likelihood value of objects of class \code{maxLik} and \code{summary.maxLik}. } \usage{ \method{logLik}{maxLik}( object, \dots ) \method{logLik}{summary.maxLik}( object, \dots ) } \arguments{ \item{object}{object of class \code{maxLik} or \code{summary.maxLik}, usually a model estimated with Maximum Likelihood} \item{...}{additional arguments to methods} } \value{ A scalar numeric, log likelihood of the estimated model. It has attribute \dQuote{df}, number of free parameters. } \author{ Arne Henningsen, Ott Toomet } \seealso{\code{\link{maxLik}}} \examples{ ## ML estimation of exponential duration model: t <- rexp(100, 2) loglik <- function(theta) log(theta) - theta*t gradlik <- function(theta) 1/theta - t hesslik <- function(theta) -100/theta^2 ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1) ## print log likelihood value logLik( a ) ## print log likelihood value of summary object b <- summary( a ) logLik( b ) } \keyword{methods} maxLik/man/maxControl.Rd0000644000176200001440000001714612611020061014665 0ustar liggesusers\name{MaxControl-class} \Rdversion{1.1} \docType{class} \alias{MaxControl-class} \alias{maxControl} \alias{maxControl,MaxControl-method} \alias{maxControl,missing-method} \alias{maxControl,maxim-method} \alias{show,MaxControl-method} \title{Class \code{"MaxControl"}} \description{ This is the structure that holds the optimization control options. The corresponding constructors take the parameters, perform consistency checks, and return the control structure. Alternatively, it overwrites the supplied parameters in an existing \code{MaxControl} structure. There is also a method to extract the control structure from the estimated \sQuote{maxim}-objects. } \section{Slots}{ The default values and definition of the slots: \describe{ \item{tol}{1e-8, stopping condition for \code{\link{maxNR}} and related optimizers. Stop if the absolute difference between successive iterations is less than \code{tol}, returns code 2.} \item{reltol}{sqrt(.Machine$double.eps), relative convergence tolerance (used by \code{\link{maxNR}} related optimizers, and \code{\link{optim}}-based optimizers. The algorithm stops if it iteration increases the value by less than a factor of \code{reltol*(abs(val) + reltol)}. Returns code 2.} \item{gradtol}{1e-6, stopping condition for \code{\link{maxNR}} and related optimizers. Stops if norm of the gradient is less than \code{gradtol}, returns code 1.} \item{steptol}{1e-10, stopping/error condition for \code{\link{maxNR}} and related optimizers. If \code{qac == "stephalving"} and the quadratic approximation leads to a worse, instead of a better value, or to \code{NA}, the step length is halved and a new attempt is made. If necessary, this procedure is repeated until \code{step < steptol}, thereafter code 3 is returned.} % \item{lambdatol}{1e-6, (for \code{\link{maxNR}} related optimizers) controls whether Hessian is treated as negative definite. If the largest of the eigenvalues of the Hessian is larger than \code{-lambdatol} (Hessian is not negative definite), a suitable diagonal matrix is subtracted from the Hessian (quadratic hill-climbing) in order to enforce negative definiteness.} % \item{qac}{"stephalving", character, Qadratic Approximation Correction for \code{\link{maxNR}} related optimizers. When the new guess is worse than the initial one, program attempts to correct it: \code{"stephalving"} decreases the step but keeps the direction. \code{"marquardt"} uses \cite{Marquardt (1963)} method by decreasing the step length while also moving closer to the pure gradient direction. It may be faster and more robust choice in areas where quadratic approximation behaves poorly.} \item{qrtol}{1e-10, QR-decomposition tolerance for Hessian inversion in \code{\link{maxNR}} related optimizers. } \item{marquardt_lambda0}{0.01, a positive numeric, initial correction term for \cite{Marquardt (1963)} correction in \code{\link{maxNR}}-related optimizers} \item{marquardt_lambdaStep}{2, how much the \cite{Marquardt (1963)} correction is decreased/increased at successful/unsuccesful step for \code{\link{maxNR}} related optimizers} \item{marquardt_maxLambda}{1e12, maximum allowed correction term for \code{\link{maxNR}} related optimizers. If exceeded, the algorithm exits with return code 3.} % \item{nm_alpha}{1, Nelder-Mead simplex method reflection factor (see Nelder \& Mead, 1965)} \item{nm_beta}{0.5, Nelder-Mead contraction factor} \item{nm_gamma}{2, Nelder-Mead expansion factor} % SANN \item{sann_cand}{\code{NULL} or a function for \code{"SANN"} algorithm to generate a new candidate point; if \code{NULL}, Gaussian Markov kernel is used (see argument \code{gr} of \code{\link{optim}}).} \item{sann_temp}{10, starting temperature for the \dQuote{SANN} cooling schedule. See \code{\link{optim}}.} \item{sann_tmax}{10, number of function evaluations at each temperature for the \dQuote{SANN} optimizer. See \code{\link{optim}}.} \item{sann_randomSeed}{123, integer to seed random numbers to ensure replicability of \dQuote{SANN} optimization and preserve \code{R} random numbers. Use options like \code{SANN_randomSeed=Sys.time()} or \code{SANN_randomeSeed=sample(1000,1)} if you want stochastic results. } % General \item{iterlim}{150, stopping condition. Stop if more than \code{iterlim} iterations performed. Note that \sQuote{iteration} may mean different things for different optimzers.} \item{printLevel}{0, the level of verbosity. Larger values print more information. Result depends on the optimizer. Form \code{print.level} is also accepted by the methods for compatibility.} } } \section{Methods}{ \describe{ \item{maxControl}{\code{(\dots)} creates a \dQuote{MaxControl} object. The arguments must be in the form \code{option1 = value1, option2 = value2, ...}. In case there are more than one option with similar name, only the last one is taken into account. This allows the user to override default parameters in the control list. See example in \link{maxLik-package}. } \item{maxControl}{\code{(x = "MaxControl", \dots)} overwrites parameters of an existing \dQuote{MaxControl} object. The \sQuote{\dots} argument must be in the form \code{option1 = value1, option2 = value2, ...}. In case there are more than one option with similar name, only the last one is taken into account. This allows the user to override default parameters in the control list. See example in \link{maxLik-package}. } \item{maxControl}{\code{(x = "maxim")} extracts \dQuote{MaxControl} structure from an estimated model} \item{show}{shows the parameter values} } } \section{Details}{ Typically, the control options are supplied in the form of a list, in which case the corresponding default values are overwritten by the user-specified ones. However, one may also create the control structure by \code{maxControl(opt1=value1, opt2=value2, ...)} and supply such value directly to the optimizer. In this case the optimization routine takes all the values from the control object. } \references{ \itemize{ \item Nelder, J. A. & Mead, R. A (1965) Simplex Method for Function Minimization \emph{The Computer Journal} \bold{7}, 308--313 \item Marquardt, D. W. (1963) An Algorithm for Least-Squares Estimation of Nonlinear Parameters \emph{Journal of the Society for Industrial and Applied Mathematics} \bold{11}, 431--441 } } \author{ Ott Toomet } \note{ Several control parameters can also be supplied directly to the optimization routines. } \examples{ ## Optimize quadratic form t(D) %*% W %*% D with p.d. weight matrix, ## s.t. constraints sum(D) = 1 quadForm <- function(D) { return(-t(D) \%*\% W \%*\% D) } eps <- 0.1 W <- diag(3) + matrix(runif(9), 3, 3)*eps D <- rep(1/3, 3) # initial values library(maxLik) ## create control object and use it for optimization co <- maxControl(printLevel=2, qac="marquardt", marquardt_lambda0=1) res <- maxNR(quadForm, start=D, control=co) print(summary(res)) ## Now perform the same with no trace information co <- maxControl(co, printLevel=0) res <- maxNR(quadForm, start=D, control=co) # no tracing information print(summary(res)) # should be the same as above maxControl(res) # shows the control structure } \keyword{utilities} maxLik/man/maxLik-package.Rd0000644000176200001440000000702712611020061015352 0ustar liggesusers\name{maxLik-package} \alias{maxLik-package} \docType{package} \title{ Maximum Likelihood Estimation } \description{ This is a set of functions and tools to perform Maximum Likelihood (ML) estimation. The focus of the package is on the non-linear optimization from the ML viewpoint, and it provides several convenience wrappers and tools, like BHHH algorithm and extraction of variance-covariance matrix. } \details{ \dQuote{maxLik} package is a set of convenience tools and wrappers to perform Maximum Likelihood (ML) analysis. It includes a) wrappers for several existing optimizers (implemented by \code{\link{optim}}); b) original optimizers, including Newton-Raphson; and c) several convenience tools to use these optimizers from the ML perspective. Examples are BHHH optimization (\code{\link{maxBHHH}}) and utilities that extract standard errors from the estimates. Other highlights include a unified interface for all included optimizers, tools to check the programmed analytic derivatives, and constrained optimization. From the user's perspective, the central function in the package is \code{\link{maxLik}}. In the simplest form it takes two arguments: the log-likelihood function, and a vector of parameters' start values. It returns an object of class \sQuote{maxLik} with convenient methods such as \code{\link[maxLik:summary.maxLik]{summary}}, \code{\link[maxLik:coef.maxim]{coef}}, and \code{\link[maxLik:stdEr.maxLik]{stdEr}}. It also supports a plethora of other arguments, for instance one can supply analytic gradient and Hessian, select the desired optimizer, and control the optimization in different ways. One of the most useful utility functions in the package is \code{\link{compareDerivatives}} that allows one to compare the analytic and numeric derivatives for debugging the derivative code. Another useful function is \code{\link{condiNumber}} for analyzing multicollinearity problems in the estimated models. } \author{ Ott Toomet , Arne Henningsen , with contributions from Spencer Graves and Yves Croissant Maintainer: Ott Toomet } %% \references{ %% } \keyword{Basics|package } \keyword{Mathematics|optimize} %% \seealso{ %% ~~ Optional links to other man pages, e.g. ~~ %% ~~ \code{\link[:-package]{}} ~~ %% } \examples{ ## estimate mean and variance of normal random vector set.seed( 123 ) x <- rnorm(50, 1, 2 ) ## log likelihood function. ## Note: 'param' is a vector llf <- function( param ) { mu <- param[ 1 ] sigma <- param[ 2 ] llValue <- dnorm(x, mean=mu, sd=sigma, log=TRUE) return(sum(llValue)) } ## Estimate it. Take standard normal as start values ml <- maxLik( llf, start = c(mu=0, sigma=1) ) print(summary(ml)) ## Estimates close to c(1,2) :-) ## Example how to use maxLik in your own function and allow users ## to override the default parameters ## ## 'estimate': user contructed estimation routine ## Note: it accepts both 'control' and '...' estimate <- function(control=NULL, ...) { return(maxLik(llf, start=c(1,1), control=c(list(iterlim=100), control), # user-supplied 'control' overrides default # 'iterlim=100' ...)) } m <- estimate(control=list(iterlim=1), fixed=2) # user can override default 'iterlim' and # supply additional parameters ('fixed') show(maxControl(m)) # iterlim should be 1 print(coef(m)) # sigma should be 1.000 } maxLik/man/maxLik-internal.Rd0000644000176200001440000000104712605106134015600 0ustar liggesusers\name{maxLik-internal} \alias{checkFuncArgs} \alias{constrOptim2} \alias{maximMessage} \alias{maxNRCompute} \alias{observationGradient} \alias{print.summary.maxim} \alias{print.summary.maxLik} \alias{returnCode.maxim} % Document the following: %%%% \title{ Internal maxLik Functions } \description{ Internal maxLik Functions } \details{ These are either various methods, or functions, not intended to be called directly by the user (or in some cases are just waiting for proper documentation to be written :). } \keyword{ internal } maxLik/man/maxNR.Rd0000644000176200001440000004157412660520442013602 0ustar liggesusers\name{maxNR} \alias{maxNR} \alias{maxBFGSR} \alias{maxBHHH} \title{Newton- and Quasi-Newton Maximization} \description{ Unconstrained and equality-constrained maximization based on the quadratic approximation (Newton) method. The Newton-Raphson, BFGS (Broyden 1970, Fletcher 1970, Goldfarb 1970, Shanno 1970), and BHHH (Berndt, Hall, Hall, Hausman 1974) methods are available. } \usage{ maxNR(fn, grad = NULL, hess = NULL, start, constraints = NULL, finalHessian = TRUE, bhhhHessian=FALSE, fixed = NULL, activePar = NULL, control=NULL, ... ) maxBFGSR(fn, grad = NULL, hess = NULL, start, constraints = NULL, finalHessian = TRUE, fixed = NULL, activePar = NULL, control=NULL, ... ) maxBHHH(fn, grad = NULL, hess = NULL, start, finalHessian = "BHHH", ... ) } \arguments{ \item{fn}{the function to be maximized. It must have the parameter vector as the first argument and it must return either a single number, or a numeric vector (this is is summed internally). If the BHHH method is used and argument \code{gradient} is not given, \code{fn} must return a numeric vector of observation-specific log-likelihood values. If the parameters are out of range, \code{fn} should return \code{NA}. See details for constant parameters. \code{fn} may also return attributes "gradient" and/or "hessian". If these attributes are set, the algorithm uses the corresponding values as gradient and Hessian. } \item{grad}{gradient of the objective function. It must have the parameter vector as the first argument and it must return either a gradient vector of the objective function, or a matrix, where \emph{columns} correspond to individual parameters. The column sums are treated as gradient components. If \code{NULL}, finite-difference gradients are computed. If BHHH method is used, \code{grad} must return a matrix, where rows corresponds to the gradient vectors for individual observations and the columns to the individual parameters. If \code{fn} returns an object with attribute \code{gradient}, this argument is ignored. } \item{hess}{Hessian matrix of the function. It must have the parameter vector as the first argument and it must return the Hessian matrix of the objective function. If missing, finite-difference Hessian, based on \code{gradient}, is computed. Hessian is used by the Newton-Raphson method only, and eventually by the other methods if \code{finalHessian} is requested.} \item{start}{initial parameter values. If start values are named, those names are also carried over to the results.} \item{constraints}{either \code{NULL} for unconstrained optimization or a list with two components. The components may be either \code{eqA} and \code{eqB} for equality-constrained optimization \eqn{A \theta + B = 0}{A \%*\% theta + B = 0}; or \code{ineqA} and \code{ineqB} for inequality constraints \eqn{A \theta + B > 0}{A \%*\% theta + B > 0}. More than one row in \code{ineqA} and \code{ineqB} corresponds to more than one linear constraint, in that case all these must be zero (equality) or positive (inequality constraints). The equality-constrained problem is forwarded to \code{\link{sumt}}, the inequality-constrained case to \code{\link{constrOptim2}}. } \item{finalHessian}{how (and if) to calculate the final Hessian. Either \code{FALSE} (do not calculate), \code{TRUE} (use analytic/finite-difference Hessian) or \code{"bhhh"}/\code{"BHHH"} for the information equality approach. The latter approach is only suitable for maximizing log-likelihood functions. It requires the gradient/log-likelihood to be supplied by individual observations. Note that computing the (actual, not BHHH) final Hessian does not carry any extra penalty for the NR method, but does for the other methods.} \item{bhhhHessian}{logical. Indicating whether to use the information equality approximation (Bernd, Hall, Hall, and Hausman, 1974) for the Hessian. This effectively transforms \code{maxNR} into \code{maxBHHH} and is mainly designed for internal use.} \item{fixed}{parameters to be treated as constants at their \code{start} values. If present, it is treated as an index vector of \code{start} parameters.} \item{activePar}{this argument is retained for backward compatibility only; please use argument \code{fixed} instead.} \item{control}{list of control parameters. The control parameters used by these optimizers are \describe{ \item{tol}{\eqn{10^{-8}}{1e-8}, stopping condition. Stop if the absolute difference between successive iterations is less than \code{tol}. Return \code{code=2}.} \item{reltol}{sqrt(.Machine$double.eps), stopping condition. Relative convergence tolerance: the algorithm stops if the relative improvement between iterations is less than \sQuote{reltol}. Return code 2. } \item{gradtol}{stopping condition. Stop if norm of the gradient is less than \code{gradtol}. Return code 1.} \item{steptol}{1e-10, stopping/error condition. If \code{qac == "stephalving"} and the quadratic approximation leads to a worse, instead of a better value, or to \code{NA}, the step length is halved and a new attempt is made. If necessary, this procedure is repeated until step < \code{steptol}, thereafter code 3 is returned.} \item{lambdatol}{\eqn{10^{-6}}{1e-6}, controls whether Hessian is treated as negative definite. If the largest of the eigenvalues of the Hessian is larger than \code{-lambdatol} (Hessian is not negative definite), a suitable diagonal matrix is subtracted from the Hessian (quadratic hill-climbing) in order to enforce negative definiteness. } \item{qrtol}{\eqn{10^{-10}}{1e-10}, QR-decomposition tolerance for the Hessian inversion. } \item{qac}{"stephalving", Quadratic Approximation Correction. When the new guess is worse than the initial one, the algorithm attemts to correct it: "stephalving" decreases the step but keeps the direction, "marquardt" uses \cite{Marquardt (1963)} method by decreasing the step length while also moving closer to the pure gradient direction. It may be faster and more robust choice in areas where quadratic approximation behaves poorly. \code{maxNR} and \code{maxBHHH} only. } \item{marquardt_lambda0}{\eqn{10^{-2}}{1e-2}, positive numeric, initial correction term for \cite{Marquardt (1963)} correction. } \item{marquardt_lambdaStep}{2, how much the \cite{Marquardt (1963)} correction term is decreased/increased at each successful/unsuccesful step. \code{maxNR} and \code{maxBHHH} only. } \item{marquardt_maxLambda}{\eqn{10^{12}}{1e12}, maximum allowed \cite{Marquardt (1963)} correction term. If exceeded, the algorithm exits with return code 3. \code{maxNR} and \code{maxBHHH} only. } \item{iterlim}{stopping condition. Stop if more than \code{iterlim} iterations, return \code{code=4}.} \item{printLevel}{this argument determines the level of printing which is done during the optimization process. The default value 0 means that no printing occurs, 1 prints the initial and final details, 2 prints all the main tracing information for every iteration. Higher values will result in even more output. } } } \item{\dots}{further arguments to \code{fn}, \code{grad} and \code{hess}. Further arguments to \code{maxBHHH} are also passed to \code{maxNR}. To maintain compatibility with the earlier versions, \dots also passes a number of control options (\code{tol}, \code{reltol}, \code{gradtol}, \code{steptol}, \code{lambdatol}, \code{qrtol}, \code{iterlim}) to the optimizers. } } \details{ The idea of the Newton method is to approximate the function at a given location by a multidimensional quadratic function, and use the estimated maximum as the start value for the next iteration. Such an approximation requires knowledge of both gradient and Hessian, the latter of which can be quite costly to compute. Several methods for approximating Hessian exist, including BFGS and BHHH. The BHHH (information equality) approximation is only valid for log-likelihood functions. It requires the score (gradient) values by individual observations and hence those must be returned by individual observations by \code{grad} or \code{fn}. The Hessian is approximated as the negative of the sum of the outer products of the gradients of individual observations, or, in the matrix form, \deqn{ \mathsf{H}^{BHHH} = -\frac{1}{N} \sum_{i=1}^N \left[ \frac{\partial \ell(\boldsymbol{\vartheta})} {\boldsymbol{\vartheta}} \frac{\partial \ell(\boldsymbol{\vartheta})} {\boldsymbol{\vartheta}'} \right] }{ \code{H = -t(gradient) \%*\% gradient = - crossprod( gradient )}. } The functions \code{maxNR}, \code{maxBFGSR}, and \code{maxBHHH} can work with constant parameters, useful if a parameter value converges to the boundary of support, or for testing. One way is to put \code{fixed} to non-NULL, specifying which parameters should be treated as constants. The parameters can also be fixed in runtime (only for \code{maxNR} and \code{maxBHHH}) by signaling it with the \code{fn} return value. See Henningsen & Toomet (2011) for details. } \value{ object of class "maxim". Data can be extracted through the following functions: \item{\code{\link{maxValue}}}{\code{fn} value at maximum (the last calculated value if not converged.)} \item{coef}{estimated parameter value.} \item{gradient}{vector, last calculated gradient value. Should be close to 0 in case of normal convergence.} \item{estfun}{matrix of gradients at parameter value \code{estimate} evaluated at each observation (only if \code{grad} returns a matrix or \code{grad} is not specified and \code{fn} returns a vector).} \item{hessian}{Hessian at the maximum (the last calculated value if not converged).} \item{returnCode}{return code: \itemize{ \item{1}{ gradient close to zero (normal convergence).} \item{2}{ successive function values within tolerance limit (normal convergence).} \item{3}{ last step could not find higher value (probably not converged). This is related to line search step getting too small, usually because hitting the boundary of the parameter space. It may also be related to attempts to move to a wrong direction because of numerical errors. In some cases it can be helped by changing \code{steptol}.} \item{4}{ iteration limit exceeded.} \item{5}{ Infinite value.} \item{6}{ Infinite gradient.} \item{7}{ Infinite Hessian.} \item{8}{ Successive function values withing relative tolerance limit (normal convergence).} \item{9}{ (BFGS) Hessian approximation cannot be improved because of gradient did not change. May be related to numerical approximation problems or wrong analytic gradient.} \item{100}{ Initial value out of range.} } } \item{returnMessage}{ a short message, describing the return code.} \item{activePar}{logical vector, which parameters are optimized over. Contains only \code{TRUE}-s if no parameters are fixed.} \item{nIter}{number of iterations.} \item{maximType}{character string, type of maximization.} \item{maxControl}{the optimization control parameters in the form of a \code{\link[maxLik:MaxControl-class]{MaxControl}} object.} The following components can only be extracted directly (with \code{\$}): \item{last.step}{a list describing the last unsuccessful step if \code{code=3} with following components: \itemize{ \item{theta0}{ previous parameter value} \item{f0}{ \code{fn} value at \code{theta0}} \item{climb}{ the movement vector to the maximum of the quadratic approximation} } } \item{constraints}{A list, describing the constrained optimization (\code{NULL} if unconstrained). Includes the following components: \itemize{ \item{type}{ type of constrained optimization} \item{outer.iterations}{ number of iterations in the constraints step} \item{barrier.value}{ value of the barrier function} } } } \section{Warning}{ No attempt is made to ensure that user-provided analytic gradient/Hessian is correct. The users are encouraged to use \code{\link{compareDerivatives}} function, designed for this purpose. If analytic gradient/Hessian are wrong, the algorithm may not converge, or may converge to a wrong point. As the BHHH method uses the likelihood-specific information equality, it is only suitable for maximizing log-likelihood functions! Quasi-Newton methods, including those mentioned above, do not work well in non-concave regions. This is especially the case with the implementation in \code{maxBFGSR}. The user is advised to experiment with various tolerance options to achieve convergence. } \references{ Berndt, E., Hall, B., Hall, R. and Hausman, J. (1974): Estimation and Inference in Nonlinear Structural Models, \emph{Annals of Social Measurement} \bold{3}, 653--665. Broyden, C.G. (1970): The Convergence of a Class of Double-rank Minimization Algorithms, \emph{Journal of the Institute of Mathematics and Its Applications} \bold{6}, 76--90. Fletcher, R. (1970): A New Approach to Variable Metric Algorithms, \emph{Computer Journal} \bold{13}, 317--322. Goldfeld, S.M. and Quandt, R.E. (1972): \emph{Nonlinear Methods in Econometrics}. Amsterdam: North-Holland. Goldfarb, D. (1970): A Family of Variable Metric Updates Derived by Variational Means, \emph{Mathematics of Computation} \bold{24}, 23--26. Greene, W.H., (2008), \emph{Econometric Analysis}, 6th edition, Prentice Hall. Henningsen, A. and Toomet, O. (2011): maxLik: A package for maximum likelihood estimation in R \emph{Computational Statistics} \bold{26}, 443--458 Marquardt, D.W., (1963) An Algorithm for Least-Squares Estimation of Nonlinear Parameters, \emph{Journal of the Society for Industrial & Applied Mathematics} \bold{11}, 2, 431--441 Shanno, D.F. (1970): Conditioning of Quasi-Newton Methods for Function Minimization, \emph{Mathematics of Computation} \bold{24}, 647--656. } \author{Ott Toomet, Arne Henningsen, function \code{maxBFGSR} was originally developed by Yves Croissant (and placed in 'mlogit' package)} \seealso{\code{\link{maxLik}} for a general framework for maximum likelihood estimation (MLE); \code{\link{maxBHHH}} for maximizations using the Berndt, Hall, Hall, Hausman (1974) algorithm (which is a wrapper function to \code{maxNR}); \code{\link{maxBFGS}} for maximization using the BFGS, Nelder-Mead (NM), and Simulated Annealing (SANN) method (based on \code{\link{optim}}), also supporting inequality constraints; \code{\link{nlm}} for Newton-Raphson optimization; and \code{\link{optim}} for different gradient-based optimization methods.} \examples{ ## estimate the exponential distribution parameter by ML t <- rexp(100, 2) loglik <- function(theta) sum(log(theta) - theta*t) ## Note the log-likelihood and gradient are summed over observations gradlik <- function(theta) sum(1/theta - t) hesslik <- function(theta) -100/theta^2 ## Estimate with finite-difference gradient and Hessian a <- maxNR(loglik, start=1, control=list(printLevel=2)) summary(a) ## You would probably prefer 1/mean(t) instead ;-) ## Estimate with analytic gradient and Hessian a <- maxNR(loglik, gradlik, hesslik, start=1) summary(a) ## BFGS estimation with finite-difference gradient a <- maxBFGSR( loglik, start=1 ) summary(a) ## For the BHHH method we need likelihood values and gradients ## of individual observations loglikInd <- function(theta) log(theta) - theta*t gradlikInd <- function(theta) 1/theta - t ## Estimate with analytic gradient a <- maxBHHH(loglikInd, gradlikInd, start=1) summary(a) ## ## Example with a vector argument: Estimate the mean and ## variance of a random normal sample by maximum likelihood ## Note: you might want to use maxLik instead ## loglik <- function(param) { mu <- param[1] sigma <- param[2] ll <- -0.5*N*log(2*pi) - N*log(sigma) - sum(0.5*(x - mu)^2/sigma^2) ll } x <- rnorm(100, 1, 2) # use mean=1, stdd=2 N <- length(x) res <- maxNR(loglik, start=c(0,1)) # use 'wrong' start values summary(res) ## ## The previous example with named parameters and fixed values ## resFix <- maxNR(loglik, start=c(mu=0, sigma=1), fixed="sigma") summary(resFix) # 'sigma' is exactly 1.000 now. ### ### Constrained optimization ### ## We maximize exp(-x^2 - y^2) where x+y = 1 hatf <- function(theta) { x <- theta[1] y <- theta[2] exp(-(x^2 + y^2)) ## Note: you may prefer exp(- theta \%*\% theta) instead } ## use constraints: x + y = 1 A <- matrix(c(1, 1), 1, 2) B <- -1 res <- maxNR(hatf, start=c(0,0), constraints=list(eqA=A, eqB=B), control=list(printLevel=1)) print(summary(res)) } \keyword{optimize} maxLik/man/maxBFGS.Rd0000644000176200001440000002174713302546750014010 0ustar liggesusers\name{maxBFGS} \alias{maxBFGS} \alias{maxCG} \alias{maxSANN} \alias{maxNM} \title{BFGS, conjugate gradient, SANN and Nelder-Mead Maximization} \description{ These functions are wrappers for \code{\link{optim}}, adding constrained optimization and fixed parameters. } \usage{ maxBFGS(fn, grad=NULL, hess=NULL, start, fixed=NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ... ) maxCG(fn, grad=NULL, hess=NULL, start, fixed=NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ...) maxSANN(fn, grad=NULL, hess=NULL, start, fixed=NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ... ) maxNM(fn, grad=NULL, hess=NULL, start, fixed=NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ...) } \arguments{ \item{fn}{function to be maximised. Must have the parameter vector as the first argument. In order to use numeric gradient and BHHH method, \code{fn} must return a vector of observation-specific likelihood values. Those are summed internally where necessary. If the parameters are out of range, \code{fn} should return \code{NA}. See details for constant parameters.} \item{grad}{gradient of \code{fn}. Must have the parameter vector as the first argument. If \code{NULL}, numeric gradient is used (\code{maxNM} and \code{maxSANN} do not use gradient). Gradient may return a matrix, where columns correspond to the parameters and rows to the observations (useful for maxBHHH). The columns are summed internally.} \item{hess}{Hessian of \code{fn}. Not used by any of these methods, included for compatibility with \code{\link{maxNR}}.} \item{start}{initial values for the parameters. If start values are named, those names are also carried over to the results.} \item{fixed}{parameters to be treated as constants at their \code{start} values. If present, it is treated as an index vector of \code{start} parameters.} \item{control}{list of control parameters or a \sQuote{MaxControl} object. If it is a list, the default values are used for the parameters that are left unspecified by the user. These functions accept the following parameters: \describe{ \item{reltol}{sqrt(.Machine$double.eps), stopping condition. Relative convergence tolerance: the algorithm stops if the relative improvement between iterations is less than \sQuote{reltol}. Note: for compatibility reason \sQuote{tol} is equivalent to \sQuote{reltol} for optim-based optimizers. } \item{iterlim}{integer, maximum number of iterations. Default values are 200 for \sQuote{BFGS}, 500 (\sQuote{CG} and \sQuote{NM}), and 10000 (\sQuote{SANN}). Note that \sQuote{iteration} may mean different things for different optimizers. } \item{printLevel}{integer, larger number prints more working information. Default 0, no information. } \item{nm_alpha}{1, Nelder-Mead simplex method reflection coefficient (see Nelder & Mead, 1965) } \item{nm_beta}{0.5, Nelder-Mead contraction coefficient} \item{nm_gamma}{2, Nelder-Mead expansion coefficient} % SANN \item{sann_cand}{\code{NULL} or a function for \code{"SANN"} algorithm to generate a new candidate point; if \code{NULL}, Gaussian Markov kernel is used (see argument \code{gr} of \code{\link{optim}}).} \item{sann_temp}{10, starting temperature for the \dQuote{SANN} cooling schedule. See \code{\link{optim}}.} \item{sann_tmax}{10, number of function evaluations at each temperature for the \dQuote{SANN} optimizer. See \code{\link{optim}}.} \item{sann_randomSeed}{123, integer to seed random numbers to ensure replicability of \dQuote{SANN} optimization and preserve \code{R} random numbers. Use options like \code{sann_randomSeed=Sys.time()} or \code{sann_randomSeed=sample(100,1)} if you want stochastic results. } } } \item{constraints}{either \code{NULL} for unconstrained optimization or a list with two components. The components may be either \code{eqA} and \code{eqB} for equality-constrained optimization \eqn{A \theta + B = 0}{A \%*\% theta + B = 0}; or \code{ineqA} and \code{ineqB} for inequality constraints \eqn{A \theta + B > 0}{A \%*\% theta + B > 0}. More than one row in \code{ineqA} and \code{ineqB} corresponds to more than one linear constraint, in that case all these must be zero (equality) or positive (inequality constraints). The equality-constrained problem is forwarded to \code{\link{sumt}}, the inequality-constrained case to \code{\link{constrOptim2}}. } \item{finalHessian}{how (and if) to calculate the final Hessian. Either \code{FALSE} (not calculate), \code{TRUE} (use analytic/numeric Hessian) or \code{"bhhh"}/\code{"BHHH"} for information equality approach. The latter approach is only suitable for maximizing log-likelihood function. It requires the gradient/log-likelihood to be supplied by individual observations, see \code{\link{maxBHHH}} for details. } \item{parscale}{A vector of scaling values for the parameters. Optimization is performed on 'par/parscale' and these should be comparable in the sense that a unit change in any element produces about a unit change in the scaled value. (see \code{\link{optim}})} \item{\dots}{further arguments for \code{fn} and \code{grad}.} } \details{ In order to provide a consistent interface, all these functions also accept arguments that other optimizers use. For instance, \code{maxNM} accepts the \sQuote{grad} argument despite being a gradient-less method. The \sQuote{state} (or \sQuote{seed}) of R's random number generator is saved at the beginning of the \code{maxSANN} function and restored at the end of this function so this function does \emph{not} affect the generation of random numbers although the random seed is set to argument \code{random.seed} and the \sQuote{SANN} algorithm uses random numbers. } \value{ object of class "maxim". Data can be extracted through the following functions: \item{maxValue}{\code{fn} value at maximum (the last calculated value if not converged.)} \item{coef}{estimated parameter value.} \item{gradient}{vector, last calculated gradient value. Should be close to 0 in case of normal convergence.} \item{estfun}{matrix of gradients at parameter value \code{estimate} evaluated at each observation (only if \code{grad} returns a matrix or \code{grad} is not specified and \code{fn} returns a vector).} \item{hessian}{Hessian at the maximum (the last calculated value if not converged).} \item{returnCode}{integer. Success code, 0 is success (see \code{\link{optim}}).} \item{returnMessage}{ a short message, describing the return code.} \item{activePar}{logical vector, which parameters are optimized over. Contains only \code{TRUE}-s if no parameters are fixed.} \item{nIter}{number of iterations. Two-element integer vector giving the number of calls to \code{fn} and \code{gr}, respectively. This excludes those calls needed to compute the Hessian, if requested, and any calls to \code{fn} to compute a finite-difference approximation to the gradient.} \item{maximType}{character string, type of maximization.} \item{maxControl}{the optimization control parameters in the form of a \code{\link[maxLik:MaxControl-class]{MaxControl}} object.} The following components can only be extracted directly (with \code{\$}): \item{constraints}{A list, describing the constrained optimization (\code{NULL} if unconstrained). Includes the following components: \describe{ \item{type}{type of constrained optimization} \item{outer.iterations}{number of iterations in the constraints step} \item{barrier.value}{value of the barrier function} } } } \author{Ott Toomet, Arne Henningsen} \seealso{\code{\link{optim}}, \code{\link{nlm}}, \code{\link{maxNR}}, \code{\link{maxBHHH}}, \code{\link{maxBFGSR}} for a \code{\link{maxNR}}-based BFGS implementation.} \references{ Nelder, J. A. & Mead, R. A, Simplex Method for Function Minimization, The Computer Journal, 1965, 7, 308-313 } \examples{ # Maximum Likelihood estimation of Poissonian distribution n <- rpois(100, 3) loglik <- function(l) n*log(l) - l - lfactorial(n) # we use numeric gradient summary(maxBFGS(loglik, start=1)) # you would probably prefer mean(n) instead of that ;-) # Note also that maxLik is better suited for Maximum Likelihood ### ### Now an example of constrained optimization ### f <- function(theta) { x <- theta[1] y <- theta[2] exp(-(x^2 + y^2)) ## you may want to use exp(- theta \%*\% theta) instead } ## use constraints: x + y >= 1 A <- matrix(c(1, 1), 1, 2) B <- -1 res <- maxNM(f, start=c(1,1), constraints=list(ineqA=A, ineqB=B), control=list(printLevel=1)) print(summary(res)) } \keyword{optimize} maxLik/man/fnSubset.Rd0000644000176200001440000000506112604100077014331 0ustar liggesusers\name{fnSubset} \alias{fnSubset} \title{ Call fnFull with variable and fixed parameters } \description{ Combine variable parameters with with fixed parameters and pass to \code{fnFull}. Useful for optimizing over a subset of parameters without writing a separate function. Values are combined by name if available. Otherwise, \code{xFull} is constructed by position (the default). } \usage{ fnSubset(x, fnFull, xFixed, xFull=c(x, xFixed), ...) } \arguments{ \item{x}{ Variable parameters to be passed to \code{fnFull}. } \item{fnFull}{ Function whose first argument has length = length(xFull). } \item{xFixed}{ Parameter values to be combined with \code{x} to construct the first argument for a call to \code{fnFull}. } \item{xFull}{ Prototype initial argument for \code{fnFull}. } \item{\dots}{ Optional arguments passed to \code{fnFull}. } } \details{ This function first confirms that \code{length(x) + length(xFixed) == length(xFull)}. Next, \itemize{ \item If \code{xFull} has names, match at least \code{xFixed} by name. \item Else \code{xFull = c(x, xFixes)}, the default. } Finally, call \code{fnFull(xFull, ...)}. } \value{ value returned by \code{fnFull} } %\references{ } \author{ Spencer Graves } \seealso{ \code{\link{optim}} \code{\link[dlm]{dlmMLE}} \code{\link{maxLik}} \code{\link{maxNR}} } \examples{ ## ## Example with 'optim' ## fn <- function(x) (x[2]-2*x[1])^2 # note: true minimum is 0 on line 2*x[1] == x[2] fullEst <- optim(par=c(1,1), method="BFGS", fn=fn) fullEst$par # par = c(0.6, 1.2) at minimum (not convex) # Fix the last component to 4 est4 <- optim(par=1, fn=fnSubset, method="BFGS", fnFull=fn, xFixed=4) est4$par # now there is a unique minimun x[1] = 2 # Fix the first component fnSubset(x=1, fnFull=fn, xFixed=c(a=4), xFull=c(a=1, b=2)) # After substitution: xFull = c(a=4, b=1), # so fn = (1 - 2*4)^2 = (-7)^2 = 49 est4. <- optim(par=1, fn=fnSubset, method="BFGS", fnFull=fn, xFixed=c(a=4), xFull=c(a=1, b=2)) est4.$par # At optimum: xFull=c(a=4, b=8), # so fn = (8 - 2*4)^2 = 0 ## ## Example with 'maxLik' ## fn2max <- function(x) -(x[2]-2*x[1])^2 # -> need to have a maximum max4 <- maxLik(fnSubset, start=1, fnFull=fn2max, xFixed=4) summary(max4) # Similar result using fixed parameters in maxNR, called by maxLik max4. <- maxLik(fn2max, start=c(1, 4), fixed=2) summary(max4.) } \keyword{optimize} \keyword{utilities} maxLik/man/compareDerivatives.Rd0000644000176200001440000000774212604075657016423 0ustar liggesusers\name{compareDerivatives} \alias{compareDerivatives} \title{function to compare analytic and numeric derivatives} \description{ This function compares analytic and numerical derivative and prints related diagnostics information. It is intended for testing and debugging code for analytic derivatives for maximization algorithms. } \usage{ compareDerivatives(f, grad, hess=NULL, t0, eps=1e-6, print=TRUE, ...) } \arguments{ \item{f}{ function to be differentiated. The parameter (vector) of interest must be the first argument. The function may return a vector, in that case the derivative will be a matrix. } \item{grad}{ analytic gradient. This may be either a function, returning the analytic gradient, or a numeric vector, the pre-computed gradient. The function must use the same set of parameters as \code{f}. If \code{f} is a vector-valued function, grad must return/be a matrix where the number of rows equals the number of components of \code{f}, and the number of columns must equal to the number of components in \code{t0}. } \item{hess}{ function returning the analytic hessian. If present, hessian matrices are compared too. Only appropriate for scalar-valued functions. } \item{t0}{ numeric vector, parameter at which the derivatives are compared. The derivative is taken with respect to this vector. both \code{f}m \code{grad} (if function) and \code{hess} (if present) must accept this value as the first parameter. } \item{eps}{ numeric. Step size for numeric differentiation. Central derivative is used. } \item{print}{ logical: TRUE to print a summary, FALSE to return the comparison only (invisibly). } \item{\dots}{ further arguments to \code{f}, \code{grad} and \code{hess}. } } \details{ Analytic derivatives (and Hessian) substantially improve the estimation speed and reliability. However, these are typically hard to program. This utility compares the programmed result and the (internally calculated) numeric derivative. For every component of \code{f}, it prints the parameter value, analytic and numeric derivative, and their relative difference \deqn{\textrm{rel.diff} = \frac{\textrm{analytic} - \textrm{numeric}}{\frac{1}{2}(\textrm{analytic} + \textrm{numeric})}.}{rel.diff = (analytic - numeric)/(0.5*(analytic + numeric)).} If analytic = 0 = numeric, the rel.diff = 0. If analytic derivatives are correct and the function is sufficiently smooth, expect the relative differences to be less than \eqn{10^{-7}}{1e-7}. } \value{ A list with following components: \item{t0}{the input argument \code{t0}} \item{f.t0}{f(t0)} \item{compareGrad}{ a list with components \code{analytic} = grad(t0), \code{nmeric} = numericGradient(f, t0), and their \code{rel.diff}. } \item{maxRelDiffGrad}{max(abs(rel.diff))} If \code{hess} is also provided, the following optional components are also present: \item{compareHessian}{ a list with components \code{analytic} = hess(t0), \code{numeric} = numericGradient(grad, t0), and their \code{rel.diff}. } \item{maxRelDiffHess}{max(abs(rel.diff)) for the Hessian} } \author{Ott Toomet \email{otoomet@ut.ee} and Spencer Graves} \seealso{ \code{\link{numericGradient}} \code{\link{deriv}} } \examples{ ## A simple example with sin(x)' = cos(x) f <- function(x)c(sin=sin(x)) Dsin <- compareDerivatives(f, cos, t0=c(angle=1)) ## ## Example of normal log-likelihood. Two-parameter ## function. ## x <- rnorm(100, 1, 2) # generate rnorm x l <- function(b) sum(dnorm(x, mean=b[1], sd=b[2], log=TRUE)) gradl <- function(b) { c(mu=sum(x - b[1])/b[2]^2, sigma=sum((x - b[1])^2/b[2]^3 - 1/b[2])) } gradl. <- compareDerivatives(l, gradl, t0=c(mu=1,sigma=2)) ## ## An example with f returning a vector, t0 = a scalar ## trig <- function(x)c(sin=sin(x), cos=cos(x)) Dtrig <- function(x)c(sin=cos(x), cos=-sin(x)) Dtrig. <- compareDerivatives(trig, Dtrig, t0=1) } \keyword{math} \keyword{utilities} maxLik/man/nParam.Rd0000644000176200001440000000236112605102662013761 0ustar liggesusers\name{nParam.maxim} \alias{nParam.maxim} \title{Number of model parameters} \description{ This function returns the number of model parameters. } \usage{ \method{nParam}{maxim}(x, free=FALSE, \dots) } \arguments{ \item{x}{a model returned by a maximisation method from the \pkg{maxLik} package.} \item{free}{logical, whether to report only the free parameters or the total number of parameters (default)} \item{\dots}{other arguments for methods} } \details{ Free parameters are the parameters with no equality restrictions. Some parameters may be jointly restricted (e.g. sum of two probabilities equals unity). In this case the total number of parameters may depend on the normalization. } \value{ Number of parameters in the model } \author{Ott Toomet} \seealso{\code{\link{nObs}} for number of observations} \examples{ ## fit a normal distribution by ML # generate a variable from normally distributed random numbers x <- rnorm( 100, 1, 2 ) # log likelihood function (for individual observations) llf <- function( param ) { return( dnorm( x, mean = param[ 1 ], sd = param[ 2 ], log = TRUE ) ) } ## ML method ml <- maxLik( llf, start = c( mu = 0, sigma = 1 ) ) # return number of parameters nParam( ml ) } \keyword{methods} maxLik/man/condiNumber.Rd0000644000176200001440000000645612612766327015035 0ustar liggesusers\name{condiNumber} \alias{condiNumber} \alias{condiNumber.default} \alias{condiNumber.maxLik} \title{Print matrix condition numbers column-by-column} \description{ This function prints the condition number of a matrix while adding columns one-by-one. This is useful for testing multicollinearity and other numerical problems. It is a generic function with a default method, and a method for \code{maxLik} objects. } \usage{ condiNumber(x, ...) \method{condiNumber}{default}(x, exact = FALSE, norm = FALSE, printLevel=print.level, print.level=1, digits = getOption( "digits" ), ... ) \method{condiNumber}{maxLik}(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{numeric matrix, condition numbers of which are to be printed} \item{exact}{logical, should condition numbers be exact or approximations (see \code{\link{kappa}})} \item{norm}{logical, whether the columns should be normalised to have unit norm} \item{printLevel}{numeric, positive value will output the numbers during the calculations. Useful for interactive work.} \item{print.level}{same as \sQuote{printLevel}, for backward compatibility} \item{digits}{minimal number of significant digits to print (only relevant if argument \code{print.level} is larger than zero).} \item{\dots}{Further arguments to \code{condiNumber.default} are currently ignored; further arguments to \code{condiNumber.maxLik} are passed to \code{condiNumber.default}.} } \details{ Statistical model often fail because of a high correlation between the explanatory variables in the linear index (multicollinearity) or because the evaluated maximum of a non-linear model is virtually flat. In both cases, the (near) singularity of the related matrices may help to understand the problem. \code{condiNumber} inspects the matrices column-by-column and indicates which variables lead to a jump in the condition number (cause singularity). If the matrix column name does not immediately indicate the problem, one may run an OLS model by estimating this column using all the previous columns as explanatory variables. Those columns that explain almost all the variation in the current one will have very high \eqn{t}{t}-values. } \value{ Invisible vector of condition numbers by column. If the start values for \code{\link{maxLik}} are named, the condition numbers are named accordingly. } \references{ Greene, W. (2012): \emph{Econometrics Analysis}, 7th edition, p. 130. } \author{Ott Toomet} \seealso{\code{\link{kappa}}} \examples{ set.seed(0) ## generate a simple nearly multicollinear dataset x1 <- runif(100) x2 <- runif(100) x3 <- x1 + x2 + 0.000001*runif(100) # this is virtually equal to x1 + x2 x4 <- runif(100) y <- x1 + x2 + x3 + x4 + rnorm(100) m <- lm(y ~ -1 + x1 + x2 + x3 + x4) print(summary(m)) # note the outlandish estimates and standard errors # while R^2 is 0.88. This suggests multicollinearity condiNumber(model.matrix(m)) # note the value 'explodes' at x3 ## we may test the results further: print(summary(lm(x3 ~ -1 + x1 + x2))) # Note the extremely high t-values and R^2: x3 is (almost) completely # explained by x1 and x2 } \keyword{math} \keyword{utilities} \keyword{debugging} % is it debugging? maxLik/man/nObs.Rd0000644000176200001440000000227312601407336013450 0ustar liggesusers\name{nObs.maxLik} \alias{nObs.maxLik} \title{Number of Observations} \description{ Returns the number of observations for statistical models, estimated by Maximum Likelihood using \code{\link{maxLik}}. } \usage{ \method{nObs}{maxLik}(x, \dots) } \arguments{ \item{x}{a statistical model estimated by Maximum Likelihood using \code{\link{maxLik}}.} \item{\dots}{further arguments (currently ignored).} } \details{ The \code{nObs} method for \dQuote{maxLik} objects can return the number of observations only if log-likelihood function (or the gradient) returns values by individual observation. } \value{ numeric, number of observations } \author{Arne Henningsen, Ott Toomet} \seealso{\code{\link[miscTools]{nObs}}, \code{\link{maxLik}}, \code{\link{nParam}}.} \examples{ ## fit a normal distribution by ML # generate a variable from normally distributed random numbers x <- rnorm( 100, 1, 2 ) # log likelihood function (for individual observations) llf <- function( param ) { return( dnorm( x, mean = param[ 1 ], sd = param[ 2 ], log = TRUE ) ) } ## ML method ml <- maxLik( llf, start = c( mu = 0, sigma = 1 ) ) # return number of onservations nObs( ml ) } \keyword{methods} maxLik/man/summary.maxLik.Rd0000644000176200001440000000406412605607173015475 0ustar liggesusers\name{summary.maxLik} \alias{summary.maxLik} \alias{coef.summary.maxLik} \title{summary the Maximum-Likelihood estimation} \description{ Summary the Maximum-Likelihood estimation including standard errors and t-values. } \usage{ \method{summary}{maxLik}(object, eigentol=1e-12, ... ) \method{coef}{summary.maxLik}(object, \ldots) } \arguments{ \item{object}{ object of class 'maxLik', or 'summary.maxLik', usually a result from Maximum-Likelihood estimation. } \item{eigentol}{ The standard errors are only calculated if the ratio of the smallest and largest eigenvalue of the Hessian matrix is less than \dQuote{eigentol}. Otherwise the Hessian is treated as singular. } \item{\ldots}{currently not used.} } \value{ An object of class 'summary.maxLik' with following components: \describe{ \item{type}{type of maximization.} \item{iterations}{number of iterations.} \item{code}{code of success.} \item{message}{a short message describing the code.} \item{loglik}{the loglik value in the maximum.} \item{estimate}{numeric matrix, the first column contains the parameter estimates, the second the standard errors, third t-values and fourth corresponding probabilities.} \item{fixed}{logical vector, which parameters are treated as constants.} \item{NActivePar}{number of free parameters.} \item{constraints}{information about the constrained optimization. Passed directly further from \code{maxim}-object. \code{NULL} if unconstrained maximization. } } } \author{Ott Toomet, Arne Henningsen} \seealso{\code{\link{maxLik}}} \examples{ ## ML estimation of exponential distribution: t <- rexp(100, 2) loglik <- function(theta) log(theta) - theta*t gradlik <- function(theta) 1/theta - t hesslik <- function(theta) -100/theta^2 ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1, control=list(printLevel=2)) summary(a) ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1, control=list(printLevel=2)) summary(a) } \keyword{models} maxLik/man/activePar.Rd0000644000176200001440000000257212604071251014463 0ustar liggesusers\name{activePar} \alias{activePar} \alias{activePar.default} \title{free parameters under maximisation} \description{ Return a logical vector, indicating which parameters were free under maximisation, as opposed to the fixed parameters that are treated as constants. See argument \dQuote{fixed} for \code{\link{maxNR}}. } \usage{ activePar(x, \dots) \method{activePar}{default}(x, \dots) } \arguments{ \item{x}{object, created by a maximisation routine, or derived from a maximisation object. } \item{\dots}{further arguments for methods} } \details{ Several optimisation routines allow the user to fix some parameter values (or do it automatically in some cases). For gradient or Hessian based inference one has to know which parameters carry optimisation-related information. } \value{ A logical vector, indicating whether the parameters were free to change during optimisation algorithm. } \author{Ott Toomet} \seealso{\code{\link{maxNR}}, \code{\link{nObs}}} \examples{ # a simple two-dimensional exponential hat f <- function(a) exp(-a[1]^2 - a[2]^2) # # maximize wrt. both parameters free <- maxNR(f, start=1:2) summary(free) # results should be close to (0,0) activePar(free) # keep the first parameter constant cons <- maxNR(f, start=1:2, fixed=c(TRUE,FALSE)) summary(cons) # result should be around (1,0) activePar(cons) } \keyword{methods} \keyword{optimize} maxLik/man/vcov.maxLik.Rd0000644000176200001440000000265212605607173014756 0ustar liggesusers\name{vcov.maxLik} \alias{vcov.maxLik} \title{Variance Covariance Matrix of maxLik objects} \description{ Extract variance-covariance matrices from \code{\link{maxLik}} objects. } \usage{ \method{vcov}{maxLik}( object, eigentol=1e-12, ... ) } \arguments{ \item{object}{a \sQuote{maxLik} object.} \item{eigentol}{ eigenvalue tolerance, controlling when the Hessian matrix is treated as numerically singular. } \item{\dots}{further arguments (currently ignored).} } \value{ the estimated variance covariance matrix of the coefficients. In case of the estimated Hessian is singular, it's values are \code{Inf}. The values corresponding to fixed parameters are zero. } \details{ The standard errors are only calculated if the ratio of the smallest and largest eigenvalue of the Hessian matrix is less than \dQuote{eigentol}. Otherwise the Hessian is treated as singular. } \author{ Arne Henningsen, Ott Toomet } \seealso{\code{\link[stats]{vcov}}, \code{\link{maxLik}}.} \examples{ ## ML estimation of exponential random variables t <- rexp(100, 2) loglik <- function(theta) log(theta) - theta*t gradlik <- function(theta) 1/theta - t hesslik <- function(theta) -100/theta^2 ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1, control=list(printLevel=2)) vcov(a) ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1) vcov(a) } \keyword{methods} maxLik/man/bread.maxLik.Rd0000644000176200001440000000275212604075657015064 0ustar liggesusers\name{bread.maxLik} \alias{bread.maxLik} \title{Bread for Sandwich Estimator} \description{ Extracting an estimator for the \sQuote{bread} of the sandwich estimator, see \code{\link[sandwich]{bread}}. } \usage{ \method{bread}{maxLik}( x, ... ) } \arguments{ \item{x}{an object of class \code{maxLik}.} \item{\dots}{further arguments (currently ignored).} } \value{ Matrix, the inverse of the expectation of the second derivative (Hessian matrix) of the log-likelihood function with respect to the parameters. In case of the simple Maximum Likelihood, it is equal to the variance covariance matrix of the parameters, multiplied by the number of observations. } \section{Warnings}{ The \pkg{sandwich} package is required for this function. This method works only if the observaton-specific gradient information was available for the estimation. This is the case if the observation-specific gradient was supplied (see the \code{grad} argument for \code{\link{maxLik}}), or the log-likelihood function returns a vector of observation-specific values. } \author{ Arne Henningsen } \seealso{\code{\link[sandwich]{bread}}, \code{\link{maxLik}}.} \examples{ ## ML estimation of exponential duration model: t <- rexp(100, 2) loglik <- function(theta) log(theta) - theta*t ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1 ) # Extract the "bread" library( sandwich ) bread( a ) all.equal( bread( a ), vcov( a ) * nObs( a ) ) } \keyword{methods} maxLik/man/returnCode.Rd0000644000176200001440000000320212605106134014646 0ustar liggesusers\name{returnCode} \alias{returnCode} \alias{returnCode.default} \alias{returnCode.maxLik} \alias{returnMessage} \alias{returnMessage.default} \alias{returnMessage.maxim} \alias{returnMessage.maxLik} \title{Success or failure of the optimization} \description{ These function extract success or failure information from optimization objects. The \code{returnCode} gives a numeric code, and \code{returnMessage} a brief description about the success or failure of the optimization, and point to the problems occured (see documentation for the corresponding functions). } \usage{ returnCode(x, ...) \method{returnCode}{default}(x, ...) \method{returnCode}{maxLik}(x, ...) returnMessage(x, ...) \method{returnMessage}{maxim}(x, ...) \method{returnMessage}{maxLik}(x, ...) } \arguments{ \item{x}{object, usually an optimization result} \item{...}{further arguments for other methods} } \details{ \code{returnMessage} and \code{returnCode} are a generic functions, with methods for various optimisation algorithms. The message should either describe the convergence (stopping condition), or the problem. } \value{ Integer for \code{returnCode}, character for \code{returnMessage}. Different optimization routines may define it in a different way. } \author{Ott Toomet} \seealso{\code{\link{maxNR}}, \code{\link{maxBFGS}}} \examples{ ## maximise the exponential bell f1 <- function(x) exp(-x^2) a <- maxNR(f1, start=2) returnCode(a) # should be success (1 or 2) returnMessage(a) ## Now try to maximise log() function a <- maxNR(log, start=2) returnCode(a) # should give a failure (4) returnMessage(a) } \keyword{methods} \keyword{utilities} maxLik/man/maxValue.Rd0000644000176200001440000000161112657517542014340 0ustar liggesusers\name{maxValue} \alias{maxValue} \alias{maxValue.maxim} \title{Function value at maximum} \description{ Returns the function value at (estimated) maximum. } \usage{ maxValue(x, ...) \method{maxValue}{maxim}(x, \dots) } \arguments{ \item{x}{a statistical model, or a result of maximisation, created by \code{\link{maxLik}}, \code{\link{maxNR}} or another optimizer.} \item{\dots}{further arguments for other methods} } \value{ numeric, the value of the objective function at maximum. In general, it is the last calculated value in case the process did not converge. } \author{Ott Toomet} \seealso{\code{\link{maxLik}}, \code{\link{maxNR}} } \examples{ ## Estimate the exponential distribution parameter: t <- rexp(100, 2) loglik <- function(theta) sum(log(theta) - theta*t) ## Estimate with numeric gradient and numeric Hessian a <- maxNR(loglik, start=1) maxValue(a) } \keyword{methods} maxLik/man/nIter.Rd0000644000176200001440000000206712605102662013627 0ustar liggesusers\name{nIter} \alias{nIter} \alias{nIter.default} \title{Return number of iterations for iterative models} \description{ Returns the number of iterations for iterative models. The default method assumes presence of a component \code{iterations} in \code{x}. } \usage{ nIter(x, \dots) \method{nIter}{default}(x, \dots) } \arguments{ \item{x}{a statistical model, or a result of maximisation, created by \code{\link{maxLik}}, \code{\link{maxNR}} or another optimizer.} \item{\dots}{further arguments for methods} } \details{ This is a generic function. The default method returns the component \code{x$iterations}. } \value{ numeric, number of iterations. Note that \sQuote{iteration} may mean different things for different optimizers. } \author{Ott Toomet} \seealso{\code{\link{maxLik}}, \code{\link{maxNR}} } \examples{ ## Estimate the exponential distribution parameter: t <- rexp(100, 2) loglik <- function(theta) sum(log(theta) - theta*t) ## Estimate with numeric gradient and numeric Hessian a <- maxNR(loglik, start=1) nIter(a) } \keyword{methods} maxLik/man/summary.maxim.Rd0000644000176200001440000000407312605106134015352 0ustar liggesusers\name{summary.maxim} \alias{summary.maxim} \title{Summary method for maximization} \description{ Summarizes the maximization results } \usage{ \method{summary}{maxim}( object, hessian=FALSE, unsucc.step=FALSE, ... ) } \arguments{ \item{object}{optimization result, object of class \code{maxim}. See \code{\link{maxNR}}.} \item{hessian}{logical, whether to display Hessian matrix.} \item{unsucc.step}{logical, whether to describe last unsuccesful step if \code{code} == 3} \item{\ldots}{currently not used.} } \value{ Object of class \code{summary.maxim}, intended to print with corresponding print method. There are following components: \item{type}{type of maximization.} \item{iterations}{number of iterations.} \item{code}{exit code (see \code{\link{returnCode}}.)} \item{message}{a brief message, explaining the outcome (see \code{\link{returnMessage}}). } \item{unsucc.step}{description of last unsuccessful step, only if requested and \code{code} == 3} \item{maximum}{function value at maximum} \item{estimate}{matrix with following columns: \describe{ \item{results}{coefficient estimates at maximum} \item{gradient}{estimated gradient at maximum} } } \item{constraints}{information about the constrained optimization. \code{NULL} if unconstrained maximization. } \item{hessian}{estimated hessian at maximum (if requested)} } \author{Ott Toomet} \seealso{\code{\link{maxNR}}, \code{\link{returnCode}}, \code{\link{returnMessage}}} \examples{ ## minimize a 2D quadratic function: f <- function(b) { x <- b[1]; y <- b[2]; val <- (x - 2)^2 + (y - 3)^2 attr(val, "gradient") <- c(2*x - 4, 2*y - 6) attr(val, "hessian") <- matrix(c(2, 0, 0, 2), 2, 2) val } ## Note that NR finds the minimum of a quadratic function with a single ## iteration. Use c(0,0) as initial value. result1 <- maxNR( f, start = c(0,0) ) summary( result1 ) ## Now use c(1000000, -777777) as initial value and ask for hessian result2 <- maxNR( f, start = c( 1000000, -777777)) summary( result2 ) } \keyword{methods} \keyword{print} maxLik/man/hessian.Rd0000644000176200001440000000336712604100077014201 0ustar liggesusers\name{hessian} \alias{hessian} \alias{hessian.default} \title{Hessian matrix} \description{ This function extracts the Hessian of the objective function at optimum. The Hessian information should be supplied by the underlying optimization algorithm, possibly by an approximation. } \usage{ hessian(x, \dots) \method{hessian}{default}(x, \dots) } \arguments{ \item{x}{an optimization result of class \sQuote{maxim} or \sQuote{maxLik}} \item{\dots}{other arguments for methods} } \value{ A numeric matrix, the Hessian of the model at the estimated parameter values. If the maximum is flat, the Hessian is singular. In that case you may want to invert only the non-singular part of the matrix. You may also want to fix certain parameters (see \code{\link{activePar}}). } \author{Ott Toomet} \seealso{\code{\link{maxLik}}, \code{\link{activePar}}, \code{\link{condiNumber}}} \examples{ # log-likelihood for normal density # a[1] - mean # a[2] - standard deviation ll <- function(a) sum(-log(a[2]) - (x - a[1])^2/(2*a[2]^2)) x <- rnorm(100) # sample from standard normal ml <- maxLik(ll, start=c(1,1)) # ignore eventual warnings "NaNs produced in: log(x)" summary(ml) # result should be close to c(0,1) hessian(ml) # How the Hessian looks like sqrt(-solve(hessian(ml))) # Note: standard deviations are on the diagonal # # Now run the same example while fixing a[2] = 1 mlf <- maxLik(ll, start=c(1,1), activePar=c(TRUE, FALSE)) summary(mlf) # first parameter close to 0, the second exactly 1.0 hessian(mlf) # Note that now NA-s are in place of passive # parameters. # now invert only the free parameter part of the Hessian sqrt(-solve(hessian(mlf)[activePar(mlf), activePar(mlf)])) # gives the standard deviation for the mean } \keyword{methods} \keyword{optimize} maxLik/man/maxLik-methods.Rd0000644000176200001440000000320512605106134015425 0ustar liggesusers\name{AIC.maxLik} \alias{AIC.maxLik} \alias{coef.maxim} \alias{coef.maxLik} \alias{stdEr.maxLik} \title{Methods for the various standard functions} \description{ These are methods for the maxLik related objects. See also the documentation for the corresponding generic functions } \usage{ \method{AIC}{maxLik}(object, \dots, k=2) \method{coef}{maxim}(object, \dots) \method{stdEr}{maxLik}(x, eigentol=1e-12, \dots) } \arguments{ \item{object}{a \sQuote{maxLik} object (or a \sQuote{maxim} object for \code{coef})} \item{k}{numeric, the penalty per parameter to be used; the default \sQuote{k = 2} is the classical AIC.} \item{x}{a \sQuote{maxLik} object} \item{eigentol}{ The standard errors are only calculated if the ration of the smallest and largest eigenvalue of the Hessian matrix is less than \dQuote{eigentol}. Otherwise the Hessian is treated as singular. } \item{\dots}{other arguments for methods} } \details{ \describe{ \item{AIC}{calculates Akaike's Information Criterion (and other information criteria).} \item{coef}{extracts the estimated parameters (model's coefficients).} \item{stdEr}{extracts standard errors (using the Hessian matrix). } } } \examples{ ## estimate mean and variance of normal random vector set.seed( 123 ) x <- rnorm(50, 1, 2 ) ## log likelihood function. ## Note: 'param' is a vector llf <- function( param ) { mu <- param[ 1 ] sigma <- param[ 2 ] return(sum(dnorm(x, mean=mu, sd=sigma, log=TRUE))) } ## Estimate it. Take standard normal as start values ml <- maxLik(llf, start = c(mu=0, sigma=1) ) coef(ml) stdEr(ml) AIC(ml) } \keyword{methods} maxLik/DESCRIPTION0000644000176200001440000000175713606005761013223 0ustar liggesusersPackage: maxLik Version: 1.3-8 Date: 2020-01-01 Title: Maximum Likelihood Estimation and Related Tools Author: Ott Toomet , Arne Henningsen , with contributions from Spencer Graves and Yves Croissant Maintainer: Ott Toomet Depends: R (>= 2.4.0), miscTools (>= 0.6-8), methods Imports: sandwich Suggests: testthat Description: Functions for Maximum Likelihood (ML) estimation and non-linear optimization, and related tools. It includes a unified way to call different optimizers, and classes and methods to handle the results from the ML viewpoint. It also includes a number of convenience tools for testing and developing your own models. License: GPL (>= 2) ByteCompile: yes Repository: CRAN Repository/R-Forge/Project: maxlik Repository/R-Forge/Revision: 1594 Repository/R-Forge/DateTimeStamp: 2020-01-02 04:47:22 Date/Publication: 2020-01-10 05:30:25 UTC NeedsCompilation: no Packaged: 2020-01-02 05:15:10 UTC; rforge maxLik/tests/0000755000176200001440000000000013603276136012650 5ustar liggesusersmaxLik/tests/methods.R0000644000176200001440000000404112660520442014427 0ustar liggesusers## Test methods. Note: only test if methods work in terms of dim, length, etc, ## not in terms of values here library(maxLik) require(testthat) require(sandwich) set.seed(0) ## Test standard methods for "lm" x <- runif(20) y <- x + rnorm(20) m <- lm(y ~ x) print(nObs(m)) print(stdEr(m)) ## Test maxControl methods: set.seed(9) x <- rnorm(20, sd=2) ll1 <- function(par) dnorm(x, mean=par, sd=1, log=TRUE) ll2 <- function(par) dnorm(x, mean=par[1], sd=par[2], log=TRUE) for(method in c("NR", "BFGS", "BFGSR")) { cat("-- method", method, "--\n") m <- maxLik(ll2, start=c(0, 2), method=method, control=list(iterlim=1)) expect_equal(maxValue(m), -41.35, tolerance=0.01) expect_true(is.vector(gradient(m)), info="'gradient' returns a vector") expect_equal(length(gradient(m)), 2, info="'gradient(m)' is of length 2") expect_true(is.matrix(estfun(m)), info="'estfun' returns a matrix") expect_equal(dim(estfun(m)), c(20,2), info="'estfun(m)' is 20x2 matrix") cat("MaxControl structure:\n") show(maxControl(m)) } ## Test methods for non-likelihood optimization hatf <- function(theta) exp(- theta %*% theta) for(optimizer in c(maxNR, maxBFGSR, maxBFGS, maxNM, maxSANN, maxCG)) { name <- as.character(quote(optimizer)) res <- optimizer(hatf, start=c(1,1)) if(name %in% c("maxNR", "maxBFGS", "maxNM", "maxCG")) { expect_equal(coef(res), c(0,0), tol=1e-5, info=paste0(name, ": result (0,0)")) } expect_equal(objectiveFn(res), hatf, info=paste0(name, ": objectiveFn correct")) } ## Test maxLik vcov related methods set.seed( 15 ) t <- rexp(20, 2) loglik <- function(theta) log(theta) - theta*t gradlik <- function(theta) 1/theta - t hesslik <- function(theta) -100/theta^2 a <- maxLik(loglik, start=1) expect_equal(dim(vcov(a)), c(1,1), info="vcov 1D numeric correct") expect_equal(length(stdEr(a)), 1, info="stdEr 1D numeric correct") a <- maxLik(loglik, gradlik, hesslik, start=1) expect_equal(dim(vcov(a)), c(1,1), info="vcov 1D analytic correct") expect_equal(length(stdEr(a)), 1, info="stdEr 1D analytic correct") maxLik/tests/numericGradient.Rout.save0000644000176200001440000000330312215570451017572 0ustar liggesusers R version 3.0.1 (2013-05-16) -- "Good Sport" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > ### test numeric methods, in particular handling of unequal > ### function lengths > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > > f <- function(x) { + if(x[1] <= 0) + return(NA) + # support of x[1] is (0, Inf) + return(c(log(x[1]),x[2])) + } > > ng <- numericGradient(f, c(0.01,1), eps=0.1) Warning message: In numericGradient(f, c(0.01, 1), eps = 0.1) : Function value at -0.04 1.00 = NA (length 1) does not conform with the length at original value 2 Component 1 set to NA > > nh <- try(numericHessian(f, t0=c(0.01,1), eps=0.1)) There were 13 warnings (use warnings() to see them) > > proc.time() user system elapsed 0.188 0.016 0.192 maxLik/tests/BFGSR.R0000644000176200001440000000357713466434557013664 0ustar liggesusers### BFGSR-related tests ## 1. Test maximization algorithm for convex regions ## ## Optimize quadratic form t(D) %*% W %*% D with p.d. weight matrix ## (ie unbounded problems). ## All solutions should go to large values with a message about successful convergence set.seed(0) options(digits=4) quadForm <- function(D) { C <- seq(1, N) return( - t(D - C) %*% W %*% ( D - C) ) } N <- 3 # 3-dimensional case ## a) test quadratic function t(D) %*% D library(maxLik) W <- diag(N) D <- rep(1/N, N) res <- maxBFGSR(quadForm, start=D) all.equal(coef(res), 1:3, tolerance=1e-4) all.equal(gradient(res), rep(0,3), tolerance=1e-3) all.equal(nIter(res) < 100, TRUE) all.equal(returnCode(res) < 4, TRUE) ## Next, optimize hat function in non-concave region. Does not work well. hat <- function(param) { ## Hat function. Hessian negative definite if sqrt(x^2 + y^2) < 0.5 x <- param[1] y <- param[2] exp(-(x-2)^2 - (y-2)^2) } hatNC <- maxBFGSR(hat, start=c(1,1), tol=0, reltol=0) all.equal(coef(hatNC), rep(2,2), tolerance=1e-4) all.equal(gradient(hatNC), rep(0,2), tolerance=1e-3) all.equal(nIter(hatNC) < 100, TRUE) all.equal(returnCode(hatNC) < 4, TRUE) ## Test BFGSR with fixed parameters and equality constraints ## Optimize 3D hat with one parameter fixed (== 2D hat). ## Add an equality constraint on that hat3 <- function(param) { ## Hat function. Hessian negative definite if sqrt((x-2)^2 + (y-2)^2) < 0.5 x <- param[1] y <- param[2] z <- param[3] exp(-(x-2)^2-(y-2)^2-(z-2)^2) } sv <- c(x=1,y=1,z=1) ## constraints: x + y + z = 8 A <- matrix(c(1,1,1), 1, 3) B <- -8 constraints <- list(eqA=A, eqB=B) hat3CF <- maxBFGSR(hat3, start=sv, constraints=constraints, fixed=3) all.equal(coef(hat3CF), c(x=3.5, y=3.5, z=1), tolerance=1e-4) all.equal(nIter(hat3CF) < 100, TRUE) all.equal(returnCode(hat3CF) < 4, TRUE) all.equal(sum(coef(hat3CF)), 8, tolerance=1e-4) maxLik/tests/numericGradient.R0000644000176200001440000000052411713530234016104 0ustar liggesusers ### test numeric methods, in particular handling of unequal ### function lengths library(maxLik) f <- function(x) { if(x[1] <= 0) return(NA) # support of x[1] is (0, Inf) return(c(log(x[1]),x[2])) } ng <- numericGradient(f, c(0.01,1), eps=0.1) nh <- try(numericHessian(f, t0=c(0.01,1), eps=0.1)) maxLik/tests/constraints.R0000644000176200001440000003177713464453351015362 0ustar liggesusers### Various tests for constrained optimization ### options(digits=4) ### -------------------- Normal mixture likelihood, no additional parameters -------------------- ### param = c(rho, mean1, mean2) ### ### X = N(mean1) w/Pr rho ### X = N(mean2) w/Pr 1-rho ### logLikMix <- function(param) { ## a single likelihood value rho <- param[1] if(rho < 0 || rho > 1) return(NA) mu1 <- param[2] mu2 <- param[3] ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) ll <- sum(ll) ll } gradLikMix <- function(param) { rho <- param[1] if(rho < 0 || rho > 1) return(NA) mu1 <- param[2] mu2 <- param[3] f1 <- dnorm(x - mu1) f2 <- dnorm(x - mu2) L <- rho*f1 + (1 - rho)*f2 g <- matrix(0, length(x), 3) g[,1] <- (f1 - f2)/L g[,2] <- rho*(x - mu1)*f1/L g[,3] <- (1 - rho)*(x - mu2)*f2/L colSums(g) g } hessLikMix <- function(param) { rho <- param[1] if(rho < 0 || rho > 1) return(NA) mu1 <- param[2] mu2 <- param[3] f1 <- dnorm(x - mu1) f2 <- dnorm(x - mu2) L <- rho*f1 + (1 - rho)*f2 dldrho <- (f1 - f2)/L dldmu1 <- rho*(x - mu1)*f1/L dldmu2 <- (1 - rho)*(x - mu2)*f2/L h <- matrix(0, 3, 3) h[1,1] <- -sum(dldrho*(f1 - f2)/L) h[2,1] <- h[1,2] <- sum((x - mu1)*f1/L - dldmu1*dldrho) h[3,1] <- h[1,3] <- sum(-(x - mu2)*f2/L - dldmu2*dldrho) h[2,2] <- sum(rho*(-f1 + (x - mu1)^2*f1)/L - dldmu1^2) h[2,3] <- h[3,2] <- -sum(dldmu1*dldmu2) h[3,3] <- sum((1 - rho)*(-f2 + (x - mu2)^2*f2)/L - dldmu2^2) h } logLikMixInd <- function(param) { ## individual obs-wise likelihood values rho <- param[1] if(rho < 0 || rho > 1) return(NA) mu1 <- param[2] mu2 <- param[3] ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) ll <- sum(ll) ll } gradLikMixInd <- function(param) { rho <- param[1] if(rho < 0 || rho > 1) return(NA) mu1 <- param[2] mu2 <- param[3] f1 <- dnorm(x - mu1) f2 <- dnorm(x - mu2) L <- rho*f1 + (1 - rho)*f2 g <- matrix(0, length(x), 3) g[,1] <- (f1 - f2)/L g[,2] <- rho*(x - mu1)*f1/L g[,3] <- (1 - rho)*(x - mu2)*f2/L colSums(g) g } ### -------------------------- library(maxLik) ## mixed normal set.seed(1) N <- 100 x <- c(rnorm(N, mean=-1), rnorm(N, mean=1)) ## ---------- INEQUALITY CONSTRAINTS ----------- ## First test inequality constraints, numeric/analytical gradients ## Inequality constraints: rho < 0.5, mu1 < -0.1, mu2 > 0.1 A <- matrix(c(-1, 0, 0, 0, -1, 0, 0, 0, 1), 3, 3, byrow=TRUE) B <- c(0.5, 0.1, 0.1) start <- c(0.4, 0, 0.9) ineqCon <- list(ineqA=A, ineqB=B) ## analytic gradient cat("Inequality constraints, analytic gradient & Hessian\n") a <- maxLik(logLikMix, grad=gradLikMix, hess=hessLikMix, start=start, constraints=ineqCon) all.equal(coef(a), c(0.5, -1, 1), tolerance=0.1) # TRUE: relative tolerance 0.045 ## No analytic gradient cat("Inequality constraints, numeric gradient & Hessian\n") a <- maxLik(logLikMix, start=start, constraints=ineqCon) all.equal(coef(a), c(0.5, -1, 1), tolerance=0.1) # should be close to the true values, but N is too small ## NR method with inequality constraints try( maxLik(logLikMix, start = start, constraints = ineqCon, method = "NR" ) ) # Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : # Inequality constraints not implemented for maxNR ## BHHH method with inequality constraints try( maxLik(logLikMix, start = start, constraints = ineqCon, method = "BHHH" ) ) # Error in maxNR(fn = fn, grad = grad, hess = hess, start = start, finalHessian = finalHessian, : # Inequality constraints not implemented for maxNR ## ---------- EQUALITY CONSTRAINTS ----------------- cat("Test for equality constraints mu1 + 2*mu2 = 0\n") A <- matrix(c(0, 1, 2), 1, 3) B <- 0 eqCon <- list( eqA = A, eqB = B ) ## default, numeric gradient mlEq <- maxLik(logLikMix, start = start, constraints = eqCon, tol=0) # only rely on gradient stopping condition all.equal(coef(mlEq), c(0.33, -1.45, 0.72), tolerance=0.01, scale=1) ## default, individual likelihood mlEqInd <- maxLik(logLikMixInd, start = start, constraints = eqCon, tol=0) # only rely on gradient stopping condition all.equal(coef(mlEq), coef(mlEqInd), tol=1e-4) ## default, analytic gradient mlEqG <- maxLik(logLikMix, grad=gradLikMix, start = start, constraints = eqCon ) all.equal(coef(mlEq), coef(mlEqG), tolerance=1e-4) ## default, analytic gradient, individual likelihood mlEqGInd <- maxLik(logLikMixInd, grad=gradLikMixInd, start = start, constraints = eqCon ) all.equal(coef(mlEqG), coef(mlEqGInd), tolerance=1e-4) ## default, analytic Hessian mlEqH <- maxLik(logLikMix, grad=gradLikMix, hess=hessLikMix, start=start, constraints=eqCon) all.equal(coef(mlEqG), coef(mlEqH), tolerance=1e-4) ## BFGS, numeric gradient eqBFGS <- maxLik(logLikMix, start=start, method="bfgs", constraints=eqCon, SUMTRho0=1) all.equal(coef(eqBFGS), c(0.33, -1.45, 0.72), tolerance=0.01, scale=1) ## BHHH, analytic gradient (numeric does not converge?) eqBHHH <- maxLik(logLikMix, gradLikMix, start=start, method="bhhh", constraints=eqCon, SUMTRho0=1) all.equal(coef(eqBFGS), coef(eqBHHH), tol=1e-4) ### ------------------ Now test additional parameters for the function ---- ### similar mixture as above but rho is give as an extra parameter ### logLikMix2 <- function(param, rho) { mu1 <- param[1] mu2 <- param[2] ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) # ll <- sum(ll) ll } gradLikMix2 <- function(param, rho) { mu1 <- param[1] mu2 <- param[2] f1 <- dnorm(x - mu1) f2 <- dnorm(x - mu2) L <- rho*f1 + (1 - rho)*f2 g <- matrix(0, length(x), 2) g[,1] <- rho*(x - mu1)*f1/L g[,2] <- (1 - rho)*(x - mu2)*f2/L # colSums(g) g } hessLikMix2 <- function(param, rho) { mu1 <- param[1] mu2 <- param[2] f1 <- dnorm(x - mu1) f2 <- dnorm(x - mu2) L <- rho*f1 + (1 - rho)*f2 dldrho <- (f1 - f2)/L dldmu1 <- rho*(x - mu1)*f1/L dldmu2 <- (1 - rho)*(x - mu2)*f2/L h <- matrix(0, 2, 2) h[1,1] <- sum(rho*(-f1 + (x - mu1)^2*f1)/L - dldmu1^2) h[1,2] <- h[2,1] <- -sum(dldmu1*dldmu2) h[2,2] <- sum((1 - rho)*(-f2 + (x - mu2)^2*f2)/L - dldmu2^2) h } ## ---------- Equality constraints & extra parameters ------------ A <- matrix(c(1, 2), 1, 2) B <- 0 start <- c(0, 1) ## We run only a few iterations as we want to test correct handling ## of parameters, not the final value. We also avoid any ## debug information iterlim <- 3 cat("Test for extra parameters for the function\n") ## NR, numeric gradient cat("Newton-Raphson, numeric gradient\n") a <- maxLik(logLikMix2, start=start, method="nr", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## NR, numeric hessian a <- maxLik(logLikMix2, gradLikMix2, start=start, method="nr", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## nr, analytic hessian a <- maxLik(logLikMix2, gradLikMix2, hessLikMix2, start=start, method="nr", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## BHHH cat("BHHH, analytic gradient, numeric Hessian\n") a <- maxLik(logLikMix2, gradLikMix2, start=start, method="bhhh", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## BHHH, analytic a <- maxLik(logLikMix2, gradLikMix2, start=start, method="bhhh", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## bfgs, no analytic gradient a <- maxLik(logLikMix2, start=start, method="bfgs", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## bfgs, analytic gradient a <- maxLik(logLikMix2, start=start, method="bfgs", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## SANN, analytic gradient a <- maxLik(logLikMix2, gradLikMix2, start=start, method="SANN", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## NM, numeric a <- maxLik(logLikMix2, start=start, method="nm", constraints=list(eqA=A, eqB=B), iterlim=100, # use more iters for NM SUMTRho0=1, rho=0.5) all.equal(coef(a), c(-1.36, 0.68), tol=0.01) ## -------------------- NR, multiple constraints -------------------- f <- function(theta) exp(-theta %*% theta) # test quadratic function ## constraints: ## theta1 + theta3 = 1 ## theta1 + theta2 = 1 A <- matrix(c(1, 0, 1, 1, 1, 0), 2, 3, byrow=TRUE) B <- c(-1, -1) cat("NR, multiple constraints\n") a <- maxNR(f, start=c(1,1.1,2), constraints=list(eqA=A, eqB=B)) theta <- coef(a) all.equal(c(theta[1] + theta[3], theta[1] + theta[2]), c(1,1), tolerance=1e-4) ## Error handling for equality constraints A <- matrix(c(1, 1), 1, 2) B <- -1 cat("Error handling: ncol(A) != lengths(start)\n") try(a <- maxNR(f, start=c(1, 2, 3), constraints=list(eqA=A, eqB=B))) # ncol(A) != length(start) A <- matrix(c(1, 1), 1, 2) B <- c(-1, 2) try(a <- maxNR(f, start=c(1, 2), constraints=list(eqA=A, eqB=B))) # nrow(A) != nrow(B) ## ## -------------- inequality constraints & extra paramters ---------------- ## ## mu1 < 1 ## mu2 > -1 A <- matrix(c(-1, 0, 0, 1), 2,2, byrow=TRUE) B <- c(1,1) start <- c(0.8, 0.9) ## inEGrad <- maxLik(logLikMix2, gradLikMix2, start=start, method="bfgs", constraints=list(ineqA=A, ineqB=B), rho=0.5) all.equal(coef(inEGrad), c(-0.98, 1.12), tol=0.01) ## inE <- maxLik(logLikMix2, start=start, method="bfgs", constraints=list(ineqA=A, ineqB=B), rho=0.5) all.equal(coef(inEGrad), coef(inE), tol=1e-4) ## inENM <- maxLik(logLikMix2, gradLikMix2, start=start, method="nm", constraints=list(ineqA=A, ineqB=B), rho=0.5) all.equal(coef(inEGrad), coef(inENM), tol=1e-3) # this is further off than gradient-based methods ## ---------- test vector B for inequality -------------- ## mu1 < 1 ## mu2 > 2 A <- matrix(c(-1, 0, 0, 1), 2,2, byrow=TRUE) B1 <- c(1,-2) a <- maxLik(logLikMix2, gradLikMix2, start=c(0.5, 2.5), method="bfgs", constraints=list(ineqA=A, ineqB=B1), rho=0.5) theta <- coef(a) all.equal(c(theta[1] < 1, theta[2] > 2), c(TRUE, TRUE)) # components should be larger than # (-1, -2) ## ## ---- ERROR HANDLING: insert wrong A and B forms ---- ## A2 <- c(-1, 0, 0, 1) try(maxLik(logLikMix2, gradLikMix2, start=start, method="bfgs", constraints=list(ineqA=A2, ineqB=B), print.level=1, rho=0.5) ) # should explain that matrix needed A2 <- matrix(c(-1, 0, 0, 1), 1, 4) try(maxLik(logLikMix2, gradLikMix2, start=start, method="bfgs", constraints=list(ineqA=A2, ineqB=B), print.level=1, rho=0.5) ) # should explain that wrong matrix # dimension B2 <- 1:3 try(maxLik(logLikMix2, gradLikMix2, start=start, method="bfgs", constraints=list(ineqA=A, ineqB=B2), print.level=1, rho=0.5) ) # A & B do not match cat("A & B do not match\n") B2 <- matrix(1,2,2) try(maxLik(logLikMix2, gradLikMix2, start=start, method="bfgs", constraints=list(ineqA=A, ineqB=B2), print.level=1, rho=0.5) ) # B must be a vector ## ---- fixed parameters with constrained optimization ----- ## Thanks to Bob Loos for finding this error. ## Optimize 3D hat with one parameter fixed (== 2D hat). ## Add an equality constraint on that cat("Constraints + fixed parameters\n") hat3 <- function(param) { ## Hat function. Hessian negative definite if sqrt(x^2 + y^2) < 0.5 x <- param[1] y <- param[2] z <- param[3] exp(-x^2-y^2-z^2) } sv <- c(1,1,1) ## constraints: x + y + z >= 2.5 A <- matrix(c(x=1,y=1,z=1), 1, 3) B <- -2.5 constraints <- list(ineqA=A, ineqB=B) res <- maxBFGS(hat3, start=sv, constraints=constraints, fixed=3, iterlim=3) all.equal(coef(res), c(0.770, 0.770, 1), tol=0.01) maxLik/tests/fitNormalDist_privateTest.Rout.save0000644000176200001440000055506213470156735021652 0ustar liggesusers R version 3.6.0 (2019-04-26) -- "Planting of a Tree" 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. 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. > ### This code tests all the methods and main parameters. It includes: > ### * analytic gradients/Hessian > ### * fixed parameters > ### * inequality constraints > ### * equality constraints > > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > library(testthat) > options(digits = 4) > # just to avoid so many differences when comparing these output files > ## data to fit a normal distribution > # set seed for pseudo random numbers > set.seed( 123 ) > tol <- .Machine$double.eps^0.25 > ## generate a variable from normally distributed random numbers > truePar <- c(mu=1, sigma=2) > x <- rnorm( 100, truePar[1], truePar[2] ) > xSaved <- x > > ## log likelihood function > llf <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + sum(dnorm(x, mu, sigma, log=TRUE)) + } > > ## log likelihood function (individual observations) > llfInd <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + llValues <- -0.5 * log( 2 * pi ) - log( sigma ) - + 0.5 * ( x - mu )^2 / sigma^2 + return( llValues ) + } > > ## function to calculate analytical gradients > gf <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + N <- length( x ) + llGrad <- c( sum( ( x - mu ) / sigma^2 ), + - N / sigma + sum( ( x - mu )^2 / sigma^3 ) ) + return( llGrad ) + } > > ## function to calculate analytical gradients (individual observations) > gfInd <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + llGrads <- cbind( ( x - mu ) / sigma^2, + - 1 / sigma + ( x - mu )^2 / sigma^3 ) + return( llGrads ) + } > > ## log likelihood function with gradients as attributes > llfGrad <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + N <- length( x ) + llValue <- -0.5 * N * log( 2 * pi ) - N * log( sigma ) - + 0.5 * sum( ( x - mu )^2 / sigma^2 ) + attributes( llValue )$gradient <- c( sum( ( x - mu ) / sigma^2 ), + - N / sigma + sum( ( x - mu )^2 / sigma^3 ) ) + return( llValue ) + } > > ## log likelihood function with gradients as attributes (individual observations) > llfGradInd <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + llValues <- -0.5 * log( 2 * pi ) - log( sigma ) - + 0.5 * ( x - mu )^2 / sigma^2 + attributes( llValues )$gradient <- cbind( ( x - mu ) / sigma^2, + - 1 / sigma + ( x - mu )^2 / sigma^3 ) + return( llValues ) + } > > ## function to calculate analytical Hessians > hf <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + N <- length( x ) + llHess <- matrix( c( + N * ( - 1 / sigma^2 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + N / sigma^2 + sum( - 3 * ( x - mu )^2 / sigma^4 ) ), + nrow = 2, ncol = 2 ) + return( llHess ) + } > > ## log likelihood function with gradients and Hessian as attributes > llfGradHess <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + N <- length( x ) + llValue <- -0.5 * N * log( 2 * pi ) - N * log( sigma ) - + 0.5 * sum( ( x - mu )^2 / sigma^2 ) + attributes( llValue )$gradient <- c( sum( ( x - mu ) / sigma^2 ), + - N / sigma + sum( ( x - mu )^2 / sigma^3 ) ) + attributes( llValue )$hessian <- matrix( c( + N * ( - 1 / sigma^2 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + N / sigma^2 + sum( - 3 * ( x - mu )^2 / sigma^4 ) ), + nrow = 2, ncol = 2 ) + return( llValue ) + } > > ## log likelihood function with gradients as attributes (individual observations) > llfGradHessInd <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + N <- length( x ) + llValues <- -0.5 * log( 2 * pi ) - log( sigma ) - + 0.5 * ( x - mu )^2 / sigma^2 + attributes( llValues )$gradient <- cbind( ( x - mu ) / sigma^2, + - 1 / sigma + ( x - mu )^2 / sigma^3 ) + attributes( llValues )$hessian <- matrix( c( + N * ( - 1 / sigma^2 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + N / sigma^2 + sum( - 3 * ( x - mu )^2 / sigma^4 ) ), + nrow = 2, ncol = 2 ) + return( llValues ) + } > > > # start values > startVal <- c( mu = 0, sigma = 1 ) > > ## basic NR: test if all methods work > ml <- maxLik( llf, start = startVal ) > expect_equal(coef(ml), truePar, tol=2*max(stdEr(ml))) > print( ml ) Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -201.6 (2 free parameter(s)) Estimate(s): 1.181 1.816 > print( summary( ml ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( ml ) mu sigma TRUE TRUE > AIC( ml ) [1] 407.2 attr(,"df") [1] 2 > coef( ml ) mu sigma 1.181 1.816 > condiNumber( ml, digits = 3 ) mu 1 sigma 1.67 > round( hessian( ml ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > logLik( ml ) [1] -201.6 attr(,"df") [1] 2 > maximType( ml ) [1] "Newton-Raphson maximisation" > nIter( ml ) [1] 7 > try( nObs( ml ) ) Error in nObs.maxLik(ml) : cannot return the number of observations: please re-run 'maxLik' and provide a gradient function using argument 'grad' or (if no gradient function is specified) a log-likelihood function using argument 'logLik' that return the gradients or log-likelihood values, respectively, at each observation > nParam( ml ) [1] 2 > returnCode( ml ) [1] 1 > returnMessage( ml ) [1] "gradient close to zero" > round( vcov( ml ), 3 ) mu sigma mu 0.033 0.000 sigma 0.000 0.017 > logLik( summary( ml ) ) [1] -201.6 attr(,"df") [1] 2 > mlInd <- maxLik( llfInd, start = startVal ) > print( summary( mlInd ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlInd[[11]][sample(nrow(mlInd[[11]]), 10),] mu sigma [1,] 0.7052 0.3528 [2,] -0.4354 -0.2062 [3,] -0.2524 -0.4348 [4,] 1.0283 1.3703 [5,] 0.2090 -0.4712 [6,] 0.7748 0.5398 [7,] -0.4718 -0.1461 [8,] -0.3377 -0.3434 [9,] -0.3414 -0.3388 [10,] 0.2169 -0.4651 > # just print a sample of 10 > nObs( mlInd ) [1] 100 > ## Marquardt (1963) correction > mlM <- maxLik( llf, start = startVal, qac="marquardt") > expect_equal(coef(mlM), coef(ml), tol=tol) > print(returnMessage(mlM)) [1] "gradient close to zero" > # coefficients should be the same as above > > # with analytical gradients > mlg <- maxLik( llf, gf, start = startVal ) > print( summary( mlg ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( ml[-c(5,6)], mlg[-c(5,6)], tolerance = 1e-3 ) [1] "Component \"hessian\": Mean relative difference: 0.001239" > mlgInd <- maxLik( llfInd, gfInd, start = startVal ) > all.equal( mlInd, mlgInd, tolerance = 1e-3 ) [1] TRUE > all.equal( mlg[ ], mlgInd[ -11 ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgInd[[ 11 ]], 3 ) mu sigma [1,] -0.395 -0.268 [2,] -0.194 -0.482 [3,] 0.890 0.888 [4,] -0.012 -0.550 [5,] 0.024 -0.550 [6,] 0.985 1.211 [7,] 0.225 -0.459 [8,] -0.822 0.676 [9,] -0.471 -0.147 [10,] -0.325 -0.359 [11,] 0.687 0.307 [12,] 0.163 -0.502 [13,] 0.188 -0.486 [14,] 0.012 -0.550 [15,] -0.392 -0.272 [16,] 1.028 1.370 [17,] 0.247 -0.440 [18,] -1.247 2.273 [19,] 0.370 -0.301 [20,] -0.341 -0.339 [21,] -0.702 0.345 [22,] -0.187 -0.487 [23,] -0.677 0.281 [24,] -0.497 -0.103 [25,] -0.434 -0.209 [26,] -1.077 1.557 [27,] 0.453 -0.178 [28,] 0.038 -0.548 [29,] -0.745 0.457 [30,] 0.705 0.353 [31,] 0.204 -0.475 [32,] -0.234 -0.451 [33,] 0.488 -0.118 [34,] 0.477 -0.136 [35,] 0.443 -0.194 [36,] 0.363 -0.312 [37,] 0.281 -0.407 [38,] -0.092 -0.535 [39,] -0.240 -0.446 [40,] -0.285 -0.403 [41,] -0.476 -0.139 [42,] -0.181 -0.491 [43,] -0.822 0.676 [44,] 1.260 2.333 [45,] 0.677 0.283 [46,] -0.736 0.432 [47,] -0.299 -0.388 [48,] -0.338 -0.343 [49,] 0.418 -0.233 [50,] -0.105 -0.530 [51,] 0.099 -0.533 [52,] -0.072 -0.541 [53,] -0.081 -0.539 [54,] 0.775 0.540 [55,] -0.192 -0.484 [56,] 0.864 0.807 [57,] -0.994 1.243 [58,] 0.300 -0.388 [59,] 0.020 -0.550 [60,] 0.076 -0.540 [61,] 0.175 -0.495 [62,] -0.359 -0.316 [63,] -0.257 -0.431 [64,] -0.672 0.270 [65,] -0.704 0.351 [66,] 0.129 -0.520 [67,] 0.217 -0.465 [68,] -0.023 -0.550 [69,] 0.504 -0.089 [70,] 1.188 2.012 [71,] -0.352 -0.325 [72,] -1.454 3.292 [73,] 0.555 0.009 [74,] -0.485 -0.124 [75,] -0.472 -0.146 [76,] 0.567 0.033 [77,] -0.227 -0.457 [78,] -0.795 0.597 [79,] 0.055 -0.545 [80,] -0.139 -0.515 [81,] -0.051 -0.546 [82,] 0.179 -0.492 [83,] -0.279 -0.409 [84,] 0.336 -0.346 [85,] -0.188 -0.486 [86,] 0.146 -0.512 [87,] 0.610 0.125 [88,] 0.209 -0.471 [89,] -0.252 -0.435 [90,] 0.642 0.197 [91,] 0.547 -0.006 [92,] 0.278 -0.411 [93,] 0.090 -0.536 [94,] -0.435 -0.206 [95,] 0.770 0.526 [96,] -0.419 -0.232 [97,] 1.271 2.384 [98,] 0.874 0.838 [99,] -0.198 -0.480 [100,] -0.677 0.282 > > # with analytical gradients as attribute > mlG <- maxLik( llfGrad, start = startVal ) > all.equal( mlG, mlg, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlG$gradient, gf( coef( mlG ) ), check.attributes = FALSE, + tolerance = 1e-3 ) [1] TRUE > mlGInd <- maxLik( llfGradInd, start = startVal ) > all.equal( mlGInd, mlgInd, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlGInd$gradient, colSums( gfInd( coef( mlGInd ) ) ), + check.attributes = FALSE, tolerance = 1e-3 ) [1] TRUE > all.equal( mlGInd$gradientObs, gfInd( coef( mlGInd ) ), + check.attributes = FALSE, tolerance = 1e-3 ) [1] TRUE > > # with analytical gradients as argument and attribute > mlgG <- maxLik( llfGrad, gf, start = startVal ) Warning message: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' > all.equal( mlgG, mlg, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgG, mlG, tolerance = 1e-3 ) [1] TRUE > > # with analytical gradients and Hessians > mlgh <- maxLik( llf, gf, hf, start = startVal ) > all.equal( mlg, mlgh, tolerance = 1e-3 ) [1] TRUE > > # with analytical gradients and Hessian as attribute > mlGH <- maxLik( llfGradHess, start = startVal ) > all.equal( mlGH, mlgh, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients and Hessian as argument and attribute > mlgGhH <- maxLik( llfGradHess, gf, hf, start = startVal ) Warning messages: 1: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' 2: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : the Hessian is provided both as attribute 'hessian' and as argument 'hess': ignoring argument 'hess' > all.equal( mlgGhH, mlgh, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGhH, mlGH, tolerance = 1e-3 ) [1] TRUE > > > ## BHHH method > mlBHHH <- try( maxLik( llf, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : if the gradients (argument 'grad') are not provided by the user, the BHHH method requires that the log-likelihood function (argument 'fn') returns a numeric vector, where each element must be the log-likelihood value corresponding to an individual (independent) observation > x <- xSaved[1] > try( maxLik( llfInd, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : if the gradients (argument 'grad') are not provided by the user, the BHHH method requires that the log-likelihood function (argument 'fn') returns a numeric vector, where each element must be the log-likelihood value corresponding to an individual (independent) observation > x <- xSaved[1:2] > try( maxLik( llfInd, start = startVal, method = "BHHH" ) ) Maximum Likelihood estimation BHHH maximisation, 8 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -0.6227 (2 free parameter(s)) Estimate(s): 0.2158 0.3302 > x <- xSaved > mlBHHH <- maxLik( llfInd, start = startVal, method = "BHHH" ) > print( mlBHHH ) Maximum Likelihood estimation BHHH maximisation, 12 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 (2 free parameter(s)) Estimate(s): 1.181 1.816 > print( summary( mlBHHH ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 12 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 13.5 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlBHHH ) mu sigma TRUE TRUE > AIC( mlBHHH ) [1] 407.2 attr(,"df") [1] 2 > coef( mlBHHH ) mu sigma 1.181 1.816 > condiNumber( mlBHHH, digits = 3 ) mu 1 sigma 1.72 > round( hessian( mlBHHH ), 1 ) mu sigma mu -30.3 -1.8 sigma -1.8 -55.7 attr(,"type") [1] "BHHH" > logLik( mlBHHH ) [1] -201.6 attr(,"df") [1] 2 > maximType( mlBHHH ) [1] "BHHH maximisation" > nIter( mlBHHH ) [1] 12 > nParam( mlBHHH ) [1] 2 > returnCode( mlBHHH ) [1] 2 > returnMessage( mlBHHH ) [1] "successive function values within tolerance limit" > round( vcov( mlBHHH ), 3 ) mu sigma mu 0.033 -0.001 sigma -0.001 0.018 > logLik( summary( mlBHHH ) ) [1] -201.6 attr(,"df") [1] 2 > all.equal( ml[-c(4,5,6,9,10) ], mlBHHH[ -c(4,5,6,9,10,11) ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlBHHH[[ 11 ]], 3 ) mu sigma [1,] -0.395 -0.268 [2,] -0.194 -0.482 [3,] 0.890 0.888 [4,] -0.012 -0.550 [5,] 0.024 -0.550 [6,] 0.985 1.211 [7,] 0.225 -0.459 [8,] -0.822 0.676 [9,] -0.471 -0.147 [10,] -0.325 -0.359 [11,] 0.687 0.307 [12,] 0.163 -0.502 [13,] 0.188 -0.486 [14,] 0.012 -0.550 [15,] -0.392 -0.272 [16,] 1.028 1.370 [17,] 0.247 -0.440 [18,] -1.247 2.273 [19,] 0.370 -0.301 [20,] -0.341 -0.339 [21,] -0.702 0.345 [22,] -0.187 -0.487 [23,] -0.677 0.281 [24,] -0.497 -0.103 [25,] -0.434 -0.209 [26,] -1.077 1.557 [27,] 0.453 -0.178 [28,] 0.038 -0.548 [29,] -0.745 0.457 [30,] 0.705 0.353 [31,] 0.204 -0.475 [32,] -0.234 -0.451 [33,] 0.488 -0.118 [34,] 0.477 -0.136 [35,] 0.443 -0.194 [36,] 0.363 -0.312 [37,] 0.281 -0.407 [38,] -0.092 -0.535 [39,] -0.240 -0.446 [40,] -0.285 -0.403 [41,] -0.476 -0.139 [42,] -0.181 -0.491 [43,] -0.822 0.676 [44,] 1.260 2.333 [45,] 0.677 0.283 [46,] -0.736 0.432 [47,] -0.299 -0.388 [48,] -0.338 -0.343 [49,] 0.418 -0.233 [50,] -0.105 -0.530 [51,] 0.099 -0.533 [52,] -0.072 -0.541 [53,] -0.081 -0.539 [54,] 0.775 0.540 [55,] -0.192 -0.484 [56,] 0.864 0.807 [57,] -0.994 1.243 [58,] 0.300 -0.388 [59,] 0.020 -0.550 [60,] 0.076 -0.540 [61,] 0.175 -0.495 [62,] -0.359 -0.316 [63,] -0.257 -0.431 [64,] -0.672 0.270 [65,] -0.704 0.351 [66,] 0.129 -0.520 [67,] 0.217 -0.465 [68,] -0.023 -0.550 [69,] 0.504 -0.089 [70,] 1.188 2.012 [71,] -0.352 -0.325 [72,] -1.454 3.292 [73,] 0.555 0.009 [74,] -0.485 -0.124 [75,] -0.472 -0.146 [76,] 0.567 0.033 [77,] -0.227 -0.457 [78,] -0.795 0.597 [79,] 0.055 -0.545 [80,] -0.139 -0.515 [81,] -0.051 -0.546 [82,] 0.179 -0.492 [83,] -0.279 -0.409 [84,] 0.336 -0.346 [85,] -0.188 -0.486 [86,] 0.146 -0.512 [87,] 0.610 0.125 [88,] 0.209 -0.471 [89,] -0.252 -0.435 [90,] 0.642 0.197 [91,] 0.547 -0.006 [92,] 0.278 -0.411 [93,] 0.090 -0.536 [94,] -0.435 -0.206 [95,] 0.770 0.526 [96,] -0.419 -0.232 [97,] 1.271 2.384 [98,] 0.874 0.838 [99,] -0.198 -0.480 [100,] -0.677 0.282 > nObs( mlBHHH ) [1] 100 > # final Hessian = usual Hessian > mlBhhhH <- maxLik( llfInd, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlBhhhH[-4], mlBHHH[-4], tolerance = 1e-3 ) [1] TRUE > round( hessian( mlBhhhH ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > print( summary( mlBhhhH ) , digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 12 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > ## Marquardt (1963) correction > mlBHHHM <- maxLik( llfInd, start = startVal, method = "BHHH", qac="marquardt") > print(coef(mlBHHHM)) mu sigma 1.181 1.816 > print(returnMessage(mlBHHHM)) [1] "successive function values within tolerance limit" > > # with analytical gradients > mlgBHHH <- try( maxLik( llf, gf, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : gradient is not a matrix but of class 'numeric'; the BHHH method requires that the gradient function (argument 'grad') returns a numeric matrix, where each row must correspond to the gradient(s) of the log-likelihood function at an individual (independent) observation and each column must correspond to a parameter > mlgBHHH <- try( maxLik( llfInd, gf, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : gradient is not a matrix but of class 'numeric'; the BHHH method requires that the gradient function (argument 'grad') returns a numeric matrix, where each row must correspond to the gradient(s) of the log-likelihood function at an individual (independent) observation and each column must correspond to a parameter > x <- xSaved[1] > try( maxLik( llf, gfInd, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : the matrix returned by the gradient function (argument 'grad') must have at least as many rows as the number of parameters (2), where each row must correspond to the gradients of the log-likelihood function of an individual (independent) observation: currently, there are (is) 2 parameter(s) but the gradient matrix has only 1 row(s) > try( maxLik( llfInd, gfInd, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : the matrix returned by the gradient function (argument 'grad') must have at least as many rows as the number of parameters (2), where each row must correspond to the gradients of the log-likelihood function of an individual (independent) observation: currently, there are (is) 2 parameter(s) but the gradient matrix has only 1 row(s) > x <- xSaved[1:2] > try( maxLik( llf, gfInd, start = startVal, method = "BHHH" ) ) Maximum Likelihood estimation BHHH maximisation, 8 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -0.6227 (2 free parameter(s)) Estimate(s): 0.2158 0.3302 > try( maxLik( llfInd, gfInd, start = startVal, method = "BHHH" ) ) Maximum Likelihood estimation BHHH maximisation, 8 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -0.6227 (2 free parameter(s)) Estimate(s): 0.2158 0.3302 > x <- xSaved > mlgBHHH <- maxLik( llfInd, gfInd, start = startVal, method = "BHHH" ) > print( summary( mlgBHHH ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 12 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 13.5 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlBHHH, mlgBHHH, tolerance = 1e-3 ) [1] TRUE > all.equal( mlg[-c(4,5,6,9,10)], mlgBHHH[-c(4,5,6,9,10,11)], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgBHHH[[ 11 ]], 3 ) mu sigma [1,] -0.395 -0.268 [2,] -0.194 -0.482 [3,] 0.890 0.888 [4,] -0.012 -0.550 [5,] 0.024 -0.550 [6,] 0.985 1.211 [7,] 0.225 -0.459 [8,] -0.822 0.676 [9,] -0.471 -0.147 [10,] -0.325 -0.359 [11,] 0.687 0.307 [12,] 0.163 -0.502 [13,] 0.188 -0.486 [14,] 0.012 -0.550 [15,] -0.392 -0.272 [16,] 1.028 1.370 [17,] 0.247 -0.440 [18,] -1.247 2.273 [19,] 0.370 -0.301 [20,] -0.341 -0.339 [21,] -0.702 0.345 [22,] -0.187 -0.487 [23,] -0.677 0.281 [24,] -0.497 -0.103 [25,] -0.434 -0.209 [26,] -1.077 1.557 [27,] 0.453 -0.178 [28,] 0.038 -0.548 [29,] -0.745 0.457 [30,] 0.705 0.353 [31,] 0.204 -0.475 [32,] -0.234 -0.451 [33,] 0.488 -0.118 [34,] 0.477 -0.136 [35,] 0.443 -0.194 [36,] 0.363 -0.312 [37,] 0.281 -0.407 [38,] -0.092 -0.535 [39,] -0.240 -0.446 [40,] -0.285 -0.403 [41,] -0.476 -0.139 [42,] -0.181 -0.491 [43,] -0.822 0.676 [44,] 1.260 2.333 [45,] 0.677 0.283 [46,] -0.736 0.432 [47,] -0.299 -0.388 [48,] -0.338 -0.343 [49,] 0.418 -0.233 [50,] -0.105 -0.530 [51,] 0.099 -0.533 [52,] -0.072 -0.541 [53,] -0.081 -0.539 [54,] 0.775 0.540 [55,] -0.192 -0.484 [56,] 0.864 0.807 [57,] -0.994 1.243 [58,] 0.300 -0.388 [59,] 0.020 -0.550 [60,] 0.076 -0.540 [61,] 0.175 -0.495 [62,] -0.359 -0.316 [63,] -0.257 -0.431 [64,] -0.672 0.270 [65,] -0.704 0.351 [66,] 0.129 -0.520 [67,] 0.217 -0.465 [68,] -0.023 -0.550 [69,] 0.504 -0.089 [70,] 1.188 2.012 [71,] -0.352 -0.325 [72,] -1.454 3.292 [73,] 0.555 0.009 [74,] -0.485 -0.124 [75,] -0.472 -0.146 [76,] 0.567 0.033 [77,] -0.227 -0.457 [78,] -0.795 0.597 [79,] 0.055 -0.545 [80,] -0.139 -0.515 [81,] -0.051 -0.546 [82,] 0.179 -0.492 [83,] -0.279 -0.409 [84,] 0.336 -0.346 [85,] -0.188 -0.486 [86,] 0.146 -0.512 [87,] 0.610 0.125 [88,] 0.209 -0.471 [89,] -0.252 -0.435 [90,] 0.642 0.197 [91,] 0.547 -0.006 [92,] 0.278 -0.411 [93,] 0.090 -0.536 [94,] -0.435 -0.206 [95,] 0.770 0.526 [96,] -0.419 -0.232 [97,] 1.271 2.384 [98,] 0.874 0.838 [99,] -0.198 -0.480 [100,] -0.677 0.282 > mlgBHHH2 <- maxLik( llf, gfInd, start = startVal, method = "BHHH" ) > all.equal( mlgBHHH, mlgBHHH2, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > # final Hessian = usual Hessian > mlgBhhhH <- maxLik( llf, gfInd, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlgBhhhH, mlBhhhH, tolerance = 1e-3 ) [1] "Component \"hessian\": Mean relative difference: 0.001233" [2] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgBhhhH[-4], mlgBHHH[-4], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( hessian( mlgBhhhH ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > > # with analytical gradients as attribute > try( maxLik( llfGrad, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : gradient is not a matrix but of class 'numeric'; the BHHH method requires that the gradient function (argument 'grad') returns a numeric matrix, where each row must correspond to the gradient(s) of the log-likelihood function at an individual (independent) observation and each column must correspond to a parameter > x <- xSaved[1] > try( maxLik( llfGrad, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : gradient is not a matrix but of class 'numeric'; the BHHH method requires that the gradient function (argument 'grad') returns a numeric matrix, where each row must correspond to the gradient(s) of the log-likelihood function at an individual (independent) observation and each column must correspond to a parameter > try( maxLik( llfGradInd, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : the matrix returned by the gradient function (argument 'grad') must have at least as many rows as the number of parameters (2), where each row must correspond to the gradients of the log-likelihood function of an individual (independent) observation: currently, there are (is) 2 parameter(s) but the gradient matrix has only 1 row(s) > x <- xSaved[1:2] > try( maxLik( llfGrad, start = startVal, method = "BHHH" ) ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : gradient is not a matrix but of class 'numeric'; the BHHH method requires that the gradient function (argument 'grad') returns a numeric matrix, where each row must correspond to the gradient(s) of the log-likelihood function at an individual (independent) observation and each column must correspond to a parameter > try( maxLik( llfGradInd, start = startVal, method = "BHHH" ) ) Maximum Likelihood estimation BHHH maximisation, 8 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -0.6227 (2 free parameter(s)) Estimate(s): 0.2158 0.3302 > x <- xSaved > mlGBHHH <- maxLik( llfGradInd, start = startVal, method = "BHHH" ) > all.equal( mlGBHHH, mlgBHHH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > # final Hessian = usual Hessian > mlGBhhhH <- maxLik( llfGradInd, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlGBhhhH, mlgBhhhH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients as argument and attribute > mlgGBHHH <- maxLik( llfGradInd, gfInd, start = startVal, method = "BHHH" ) Warning message: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' > all.equal( mlgGBHHH, mlgBHHH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGBHHH, mlGBHHH, tolerance = 1e-3 ) [1] TRUE > > # with unused Hessian > mlghBHHH <- maxLik( llfInd, gfInd, hf, start = startVal, method = "BHHH" ) > all.equal( mlgBHHH, mlghBHHH, tolerance = 1e-3 ) [1] TRUE > # final Hessian = usual Hessian > mlghBhhhH <- maxLik( llfInd, gfInd, hf, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlghBhhhH[-4], mlghBHHH[-4], tolerance = 1e-3 ) [1] TRUE > all.equal( mlghBhhhH, mlgBhhhH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with unused Hessian as attribute > mlGHBHHH <- maxLik( llfGradHessInd, start = startVal, method = "BHHH" ) > all.equal( mlGHBHHH, mlghBHHH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > # final Hessian = usual Hessian > mlGHBhhhH <- maxLik( llfGradHessInd, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlGHBhhhH, mlghBhhhH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients and Hessian as argument and attribute > mlgGhHBHHH <- maxLik( llfGradHessInd, gfInd, hf, start = startVal, method = "BHHH" ) Warning messages: 1: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' 2: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : the Hessian is provided both as attribute 'hessian' and as argument 'hess': ignoring argument 'hess' > all.equal( mlgGhHBHHH, mlghBHHH, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGhHBHHH, mlGHBHHH, tolerance = 1e-3 ) [1] TRUE > > > > ### BFGSR method > mlBFGSYC <- maxLik( llf, start = startVal, method = "bfgsr" ) > print( mlBFGSYC ) Maximum Likelihood estimation BFGSR maximization, 15 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 (2 free parameter(s)) Estimate(s): 1.181 1.816 > print( summary( mlBFGSYC ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 15 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlBFGSYC ) mu sigma TRUE TRUE > AIC( mlBFGSYC ) [1] 407.2 attr(,"df") [1] 2 > coef( mlBFGSYC ) mu sigma 1.181 1.816 > condiNumber( mlBFGSYC, digits = 3 ) mu 1 sigma 1.67 > round( hessian( mlBFGSYC ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > logLik( mlBFGSYC ) [1] -201.6 attr(,"df") [1] 2 > maximType( mlBFGSYC ) [1] "BFGSR maximization" > nIter( mlBFGSYC ) [1] 15 > try( nObs( mlBFGSYC ) ) Error in nObs.maxLik(mlBFGSYC) : cannot return the number of observations: please re-run 'maxLik' and provide a gradient function using argument 'grad' or (if no gradient function is specified) a log-likelihood function using argument 'logLik' that return the gradients or log-likelihood values, respectively, at each observation > nParam( mlBFGSYC ) [1] 2 > returnCode( mlBFGSYC ) [1] 2 > returnMessage( mlBFGSYC ) [1] "successive function values within tolerance limit" > round( vcov( mlBFGSYC ), 3 ) mu sigma mu 0.033 0.000 sigma 0.000 0.017 > logLik( summary( mlBFGSYC ) ) [1] -201.6 attr(,"df") [1] 2 > all.equal( ml[-c(3,4,5,6,9,10)], mlBFGSYC[-c(3,4,5,6,9,10)], tolerance = 1e-3 ) [1] TRUE > all.equal( ml[-c(5,6,9,10)], mlBFGSYC[-c(5,6,9,10)], tolerance = 1e-2 ) [1] TRUE > mlIndBFGSYC <- maxLik( llfInd, start = startVal, method = "BFGSR" ) > print( summary( mlIndBFGSYC ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 34 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlBFGSYC[-c(3,4,9)], mlIndBFGSYC[ -c(3,4,9,11) ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlIndBFGSYC[[ 11 ]], 3 ) mu sigma [1,] -0.395 -0.268 [2,] -0.194 -0.482 [3,] 0.890 0.889 [4,] -0.012 -0.550 [5,] 0.024 -0.550 [6,] 0.985 1.211 [7,] 0.225 -0.459 [8,] -0.822 0.676 [9,] -0.471 -0.147 [10,] -0.325 -0.359 [11,] 0.687 0.307 [12,] 0.163 -0.502 [13,] 0.188 -0.486 [14,] 0.012 -0.550 [15,] -0.392 -0.272 [16,] 1.028 1.371 [17,] 0.247 -0.440 [18,] -1.247 2.274 [19,] 0.370 -0.301 [20,] -0.341 -0.339 [21,] -0.702 0.345 [22,] -0.187 -0.487 [23,] -0.677 0.281 [24,] -0.497 -0.102 [25,] -0.434 -0.209 [26,] -1.077 1.557 [27,] 0.453 -0.178 [28,] 0.038 -0.548 [29,] -0.745 0.457 [30,] 0.705 0.353 [31,] 0.204 -0.475 [32,] -0.234 -0.451 [33,] 0.488 -0.118 [34,] 0.478 -0.136 [35,] 0.443 -0.194 [36,] 0.363 -0.312 [37,] 0.281 -0.407 [38,] -0.092 -0.535 [39,] -0.240 -0.446 [40,] -0.285 -0.403 [41,] -0.476 -0.139 [42,] -0.181 -0.491 [43,] -0.822 0.676 [44,] 1.260 2.333 [45,] 0.677 0.283 [46,] -0.736 0.432 [47,] -0.299 -0.388 [48,] -0.338 -0.343 [49,] 0.418 -0.233 [50,] -0.105 -0.530 [51,] 0.099 -0.533 [52,] -0.072 -0.541 [53,] -0.081 -0.539 [54,] 0.775 0.540 [55,] -0.192 -0.484 [56,] 0.865 0.807 [57,] -0.994 1.243 [58,] 0.300 -0.388 [59,] 0.020 -0.550 [60,] 0.076 -0.540 [61,] 0.175 -0.495 [62,] -0.359 -0.316 [63,] -0.257 -0.431 [64,] -0.672 0.270 [65,] -0.705 0.351 [66,] 0.129 -0.520 [67,] 0.217 -0.465 [68,] -0.023 -0.550 [69,] 0.504 -0.089 [70,] 1.188 2.013 [71,] -0.352 -0.325 [72,] -1.455 3.293 [73,] 0.555 0.009 [74,] -0.485 -0.124 [75,] -0.472 -0.146 [76,] 0.567 0.033 [77,] -0.227 -0.457 [78,] -0.795 0.597 [79,] 0.055 -0.545 [80,] -0.139 -0.515 [81,] -0.051 -0.546 [82,] 0.179 -0.493 [83,] -0.280 -0.409 [84,] 0.336 -0.346 [85,] -0.188 -0.486 [86,] 0.146 -0.512 [87,] 0.610 0.126 [88,] 0.209 -0.471 [89,] -0.252 -0.435 [90,] 0.642 0.197 [91,] 0.547 -0.006 [92,] 0.278 -0.411 [93,] 0.090 -0.536 [94,] -0.435 -0.206 [95,] 0.770 0.526 [96,] -0.419 -0.232 [97,] 1.271 2.385 [98,] 0.874 0.838 [99,] -0.198 -0.480 [100,] -0.677 0.282 > nObs( mlIndBFGSYC ) [1] 100 > > # with analytical gradients > mlgBFGSYC <- maxLik( llf, gf, start = startVal, method = "BFGSR" , print.level=1) Initial value of the function : -326.6 Iteration 1 step = 1, lnL = -325.1, chi2 = 1.504, function increment = 1.494 Iteration 2 step = 1, lnL = -254.9, chi2 = 107.8, function increment = 70.19 Iteration 3 step = 1, lnL = -254.8, chi2 = 0.147, function increment = 0.1464 Iteration 4 step = 1, lnL = -250, chi2 = 18.76, function increment = 4.778 Iteration 5 step = 0.25, lnL = -218.8, chi2 = 1496, function increment = 31.18 Iteration 6 step = 1, lnL = -201.7, chi2 = 22.41, function increment = 17.06 Iteration 7 step = 0.25, lnL = -201.7, chi2 = 0.7577, function increment = 0.08696 Iteration 8 step = 1, lnL = -201.6, chi2 = 0.07892, function increment = 0.05362 Iteration 9 step = 0.25, lnL = -201.6, chi2 = 0.07185, function increment = 0.004091 Iteration 10 step = 0.125, lnL = -201.6, chi2 = 0.223, function increment = 0.01277 Iteration 11 step = 0.0625, lnL = -201.6, chi2 = 0.002795, function increment = 6.314e-05 Iteration 12 step = 0.5, lnL = -201.6, chi2 = 0.0001251, function increment = 2.456e-05 Iteration 13 step = 0.0625, lnL = -201.6, chi2 = 6.645e-05, function increment = 4.239e-07 Iteration 14 step = 0.03125, lnL = -201.6, chi2 = 1.782e-05, function increment = 2.54e-07 Iteration 15 step = 0.01562, lnL = -201.6, chi2 = 5.203e-08, function increment = 2.604e-10 -------------- successive function values within tolerance limit 15 iterations estimate: 1.181 1.816 Function value: -201.6 > print( summary(mlgBFGSYC), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 15 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlBFGSYC[-4], mlgBFGSYC[-4], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"printLevel\": Mean absolute difference: 1 >" > mlgIndBFGSYC <- maxLik( llfInd, gfInd, start = startVal, + method = "BFGSR" ) > all.equal( mlIndBFGSYC, mlgIndBFGSYC, tolerance = 1e-3 ) [1] "Component \"hessian\": Mean relative difference: 0.001516" > all.equal( mlgBFGSYC[ -c(3,9) ], mlgIndBFGSYC[ -c(3,9,11) ], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"printLevel\": Mean relative difference: 1 >" [2] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgIndBFGSYC[[ 11 ]], 3 ) mu sigma [1,] -0.395 -0.268 [2,] -0.194 -0.482 [3,] 0.890 0.889 [4,] -0.012 -0.550 [5,] 0.024 -0.550 [6,] 0.985 1.211 [7,] 0.225 -0.459 [8,] -0.822 0.676 [9,] -0.471 -0.147 [10,] -0.325 -0.359 [11,] 0.687 0.307 [12,] 0.163 -0.502 [13,] 0.188 -0.486 [14,] 0.012 -0.550 [15,] -0.392 -0.272 [16,] 1.028 1.371 [17,] 0.247 -0.440 [18,] -1.247 2.274 [19,] 0.370 -0.301 [20,] -0.341 -0.339 [21,] -0.702 0.345 [22,] -0.187 -0.487 [23,] -0.677 0.281 [24,] -0.497 -0.102 [25,] -0.434 -0.209 [26,] -1.077 1.557 [27,] 0.453 -0.178 [28,] 0.038 -0.548 [29,] -0.745 0.457 [30,] 0.705 0.353 [31,] 0.204 -0.475 [32,] -0.234 -0.451 [33,] 0.488 -0.118 [34,] 0.478 -0.136 [35,] 0.443 -0.194 [36,] 0.363 -0.312 [37,] 0.281 -0.407 [38,] -0.092 -0.535 [39,] -0.240 -0.446 [40,] -0.285 -0.403 [41,] -0.476 -0.139 [42,] -0.181 -0.491 [43,] -0.822 0.676 [44,] 1.260 2.333 [45,] 0.677 0.283 [46,] -0.736 0.432 [47,] -0.299 -0.388 [48,] -0.338 -0.343 [49,] 0.418 -0.233 [50,] -0.105 -0.530 [51,] 0.099 -0.533 [52,] -0.072 -0.541 [53,] -0.081 -0.539 [54,] 0.775 0.540 [55,] -0.192 -0.484 [56,] 0.865 0.807 [57,] -0.994 1.243 [58,] 0.300 -0.388 [59,] 0.020 -0.550 [60,] 0.076 -0.540 [61,] 0.175 -0.495 [62,] -0.359 -0.316 [63,] -0.257 -0.431 [64,] -0.672 0.270 [65,] -0.705 0.351 [66,] 0.129 -0.520 [67,] 0.217 -0.465 [68,] -0.023 -0.550 [69,] 0.504 -0.089 [70,] 1.188 2.013 [71,] -0.352 -0.325 [72,] -1.455 3.293 [73,] 0.555 0.009 [74,] -0.485 -0.124 [75,] -0.472 -0.146 [76,] 0.567 0.033 [77,] -0.227 -0.457 [78,] -0.795 0.597 [79,] 0.055 -0.545 [80,] -0.139 -0.515 [81,] -0.051 -0.546 [82,] 0.179 -0.493 [83,] -0.280 -0.409 [84,] 0.336 -0.346 [85,] -0.188 -0.486 [86,] 0.146 -0.512 [87,] 0.610 0.126 [88,] 0.209 -0.471 [89,] -0.252 -0.435 [90,] 0.642 0.197 [91,] 0.547 -0.006 [92,] 0.278 -0.411 [93,] 0.090 -0.536 [94,] -0.435 -0.206 [95,] 0.770 0.526 [96,] -0.419 -0.232 [97,] 1.271 2.385 [98,] 0.874 0.838 [99,] -0.198 -0.480 [100,] -0.677 0.282 > > # with analytical gradients as attribute > mlGBFGSYC <- maxLik( llfGrad, start = startVal, method = "BFGSR" , print.level=1) Initial value of the function : -326.6 Iteration 1 step = 1, lnL = -325.1, chi2 = 1.504, function increment = 1.494 Iteration 2 step = 1, lnL = -254.9, chi2 = 107.8, function increment = 70.19 Iteration 3 step = 1, lnL = -254.8, chi2 = 0.147, function increment = 0.1464 Iteration 4 step = 1, lnL = -250, chi2 = 18.76, function increment = 4.778 Iteration 5 step = 0.25, lnL = -218.8, chi2 = 1496, function increment = 31.18 Iteration 6 step = 1, lnL = -201.7, chi2 = 22.41, function increment = 17.06 Iteration 7 step = 0.25, lnL = -201.7, chi2 = 0.7577, function increment = 0.08696 Iteration 8 step = 1, lnL = -201.6, chi2 = 0.07892, function increment = 0.05362 Iteration 9 step = 0.25, lnL = -201.6, chi2 = 0.07185, function increment = 0.004091 Iteration 10 step = 0.125, lnL = -201.6, chi2 = 0.223, function increment = 0.01277 Iteration 11 step = 0.0625, lnL = -201.6, chi2 = 0.002795, function increment = 6.314e-05 Iteration 12 step = 0.5, lnL = -201.6, chi2 = 0.0001251, function increment = 2.456e-05 Iteration 13 step = 0.0625, lnL = -201.6, chi2 = 6.645e-05, function increment = 4.239e-07 Iteration 14 step = 0.03125, lnL = -201.6, chi2 = 1.782e-05, function increment = 2.54e-07 Iteration 15 step = 0.01562, lnL = -201.6, chi2 = 5.203e-08, function increment = 2.604e-10 -------------- successive function values within tolerance limit 15 iterations estimate: 1.181 1.816 Function value: -201.6 > all.equal( mlGBFGSYC, mlgBFGSYC, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlGIndBFGSYC <- maxLik( llfGradInd, start = startVal, method = "BFGSR" ) > all.equal( mlGIndBFGSYC, mlgIndBFGSYC, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients as argument and attribute > mlgGBFGSYC <- maxLik( llfGrad, gf, start = startVal, method = "BFGSR" ) Warning message: In maxBFGSRCompute(fn = function (theta, fnOrig, gradOrig = NULL, : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' > all.equal( mlgGBFGSYC, mlgBFGSYC, tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"printLevel\": Mean absolute difference: 1 >" [2] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGBFGSYC, mlGBFGSYC, tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"printLevel\": Mean absolute difference: 1 >" > > # with analytical gradients and Hessians > mlghBFGSYC <- maxLik( llf, gf, hf, start = startVal, method = "BFGSR" ) > all.equal( mlgBFGSYC, mlghBFGSYC, tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"printLevel\": Mean relative difference: 1 >" > > # with analytical gradients and Hessian as attribute > mlGHBFGSYC <- maxLik( llfGradHess, start = startVal, method = "BFGSR" ) > all.equal( mlGHBFGSYC, mlghBFGSYC, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients and Hessian as argument and attribute > mlgGhHBFGSYC <- maxLik( llfGradHess, gf, hf, start = startVal, method = "BFGSR" ) Warning messages: 1: In maxBFGSRCompute(fn = function (theta, fnOrig, gradOrig = NULL, : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' 2: In maxBFGSRCompute(fn = function (theta, fnOrig, gradOrig = NULL, : the Hessian is provided both as attribute 'hessian' and as argument 'hess': ignoring argument 'hess' > all.equal( mlgGhHBFGSYC, mlghBFGSYC, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGhHBFGSYC, mlGHBFGSYC, tolerance = 1e-3 ) [1] TRUE > > > ## BFGS method > mlBFGS <- maxLik( llf, start = startVal, method = "BFGS" ) > print( mlBFGS ) Maximum Likelihood estimation BFGS maximization, 36 iterations Return code 0: successful convergence Log-Likelihood: -201.6 (2 free parameter(s)) Estimate(s): 1.181 1.816 > print( summary( mlBFGS ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 36 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlBFGS ) mu sigma TRUE TRUE > AIC( mlBFGS ) [1] 407.2 attr(,"df") [1] 2 > coef( mlBFGS ) mu sigma 1.181 1.816 > condiNumber( mlBFGS, digits = 3 ) mu 1 sigma 1.67 > round( hessian( mlBFGS ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > logLik( mlBFGS ) [1] -201.6 attr(,"df") [1] 2 > maximType( mlBFGS ) [1] "BFGS maximization" > nIter( mlBFGS ) function 36 > nParam( mlBFGS ) [1] 2 > returnCode( mlBFGS ) [1] 0 > returnMessage( mlBFGS ) [1] "successful convergence " > round( vcov( mlBFGS ), 3 ) mu sigma mu 0.033 0.000 sigma 0.000 0.016 > logLik( summary( mlBFGS ) ) [1] -201.6 attr(,"df") [1] 2 > all.equal( ml[-c(4,5,6,9,10)], mlBFGS[-c(4,5,6,9,10,11)], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 0.3333 >" > # with individual log likelihood values > mlIndBFGS <- maxLik( llfInd, start = startVal, method = "BFGS" ) > print( summary( mlIndBFGS ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 36 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlBFGS[-4], mlIndBFGS[-c(4,12)], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlIndBFGS[12] $gradientObs mu sigma [1,] -0.39452 -0.267786 [2,] -0.19432 -0.481927 [3,] 0.88999 0.888279 [4,] -0.01206 -0.550251 [5,] 0.02357 -0.549506 [6,] 0.98476 1.211023 [7,] 0.22458 -0.458899 [8,] -0.82159 0.675638 [9,] -0.47112 -0.147336 [10,] -0.32493 -0.358734 [11,] 0.68716 0.307205 [12,] 0.16330 -0.502076 [13,] 0.18812 -0.486229 [14,] 0.01229 -0.550240 [15,] -0.39171 -0.271798 [16,] 1.02831 1.370271 [17,] 0.24697 -0.439724 [18,] -1.24683 2.273358 [19,] 0.37032 -0.301412 [20,] -0.34137 -0.338831 [21,] -0.70204 0.344759 [22,] -0.18692 -0.487049 [23,] -0.67669 0.281276 [24,] -0.49660 -0.102544 [25,] -0.43365 -0.208914 [26,] -1.07716 1.557095 [27,] 0.45301 -0.177735 [28,] 0.03817 -0.547869 [29,] -0.74466 0.456758 [30,] 0.70518 0.352786 [31,] 0.20370 -0.475145 [32,] -0.23365 -0.451349 [33,] 0.48777 -0.118342 [34,] 0.47747 -0.136401 [35,] 0.44319 -0.193726 [36,] 0.36261 -0.311673 [37,] 0.28095 -0.407134 [38,] -0.09232 -0.535032 [39,] -0.24025 -0.445666 [40,] -0.28541 -0.402542 [41,] -0.47588 -0.139147 [42,] -0.18082 -0.491121 [43,] -0.82180 0.676245 [44,] 1.25988 2.332775 [45,] 0.67739 0.282986 [46,] -0.73555 0.432266 [47,] -0.29900 -0.388120 [48,] -0.33765 -0.343419 [49,] 0.41797 -0.233185 [50,] -0.10533 -0.530362 [51,] 0.09875 -0.532802 [52,] -0.07210 -0.541072 [53,] -0.08078 -0.538661 [54,] 0.77476 0.539827 [55,] -0.19164 -0.483800 [56,] 0.86439 0.806692 [57,] -0.99355 1.242603 [58,] 0.29956 -0.387515 [59,] 0.02027 -0.549768 [60,] 0.07609 -0.539998 [61,] 0.17531 -0.494685 [62,] -0.35927 -0.316049 [63,] -0.25677 -0.430757 [64,] -0.67219 0.270243 [65,] -0.70445 0.350903 [66,] 0.12918 -0.520202 [67,] 0.21688 -0.465075 [68,] -0.02267 -0.549581 [69,] 0.50422 -0.088698 [70,] 1.18783 2.012418 [71,] -0.35243 -0.324898 [72,] -1.45446 3.292176 [73,] 0.55481 0.008632 [74,] -0.48467 -0.123818 [75,] -0.47182 -0.146136 [76,] 0.56684 0.033125 [77,] -0.22741 -0.456577 [78,] -0.79472 0.596724 [79,] 0.05510 -0.545001 [80,] -0.13898 -0.515427 [81,] -0.05130 -0.545734 [82,] 0.17873 -0.492486 [83,] -0.27947 -0.408644 [84,] 0.33578 -0.345709 [85,] -0.18844 -0.486011 [86,] 0.14631 -0.511632 [87,] 0.61003 0.125471 [88,] 0.20898 -0.471184 [89,] -0.25236 -0.434835 [90,] 0.64153 0.197084 [91,] 0.54740 -0.006216 [92,] 0.27760 -0.410530 [93,] 0.08991 -0.535832 [94,] -0.43539 -0.206171 [95,] 0.76994 0.526306 [96,] -0.41863 -0.232167 [97,] 1.27102 2.383985 [98,] 0.87417 0.837587 [99,] -0.19766 -0.479543 [100,] -0.67695 0.281897 > nObs( mlIndBFGS ) [1] 100 > > # with analytical gradients > mlgBFGS <- maxLik( llf, gf, start = startVal, method = "BFGS" ) > print( summary( mlgBFGS ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 36 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlBFGS[-4], mlgBFGS[-4], tolerance = 1e-3 ) [1] TRUE > all.equal( mlg[-c(5,6,9,10)], mlgBFGS[-c(5,6,9,10,11)], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 0.3333 >" > mlgIndBFGS <- maxLik( llfInd, gfInd, start = startVal, method = "BFGS" ) > all.equal( mlgBFGS[], mlgIndBFGS[-12], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlgIndBFGS[12] $gradientObs mu sigma [1,] -0.39452 -0.267786 [2,] -0.19432 -0.481927 [3,] 0.88999 0.888279 [4,] -0.01206 -0.550251 [5,] 0.02357 -0.549506 [6,] 0.98476 1.211023 [7,] 0.22458 -0.458899 [8,] -0.82159 0.675638 [9,] -0.47112 -0.147336 [10,] -0.32493 -0.358734 [11,] 0.68716 0.307205 [12,] 0.16330 -0.502076 [13,] 0.18812 -0.486229 [14,] 0.01229 -0.550240 [15,] -0.39171 -0.271798 [16,] 1.02831 1.370271 [17,] 0.24697 -0.439724 [18,] -1.24683 2.273358 [19,] 0.37032 -0.301412 [20,] -0.34137 -0.338831 [21,] -0.70204 0.344759 [22,] -0.18692 -0.487049 [23,] -0.67669 0.281276 [24,] -0.49660 -0.102544 [25,] -0.43365 -0.208914 [26,] -1.07716 1.557095 [27,] 0.45301 -0.177735 [28,] 0.03817 -0.547869 [29,] -0.74466 0.456758 [30,] 0.70518 0.352786 [31,] 0.20370 -0.475145 [32,] -0.23365 -0.451349 [33,] 0.48777 -0.118342 [34,] 0.47747 -0.136401 [35,] 0.44319 -0.193726 [36,] 0.36261 -0.311673 [37,] 0.28095 -0.407134 [38,] -0.09232 -0.535032 [39,] -0.24025 -0.445666 [40,] -0.28541 -0.402542 [41,] -0.47588 -0.139147 [42,] -0.18082 -0.491121 [43,] -0.82180 0.676245 [44,] 1.25988 2.332775 [45,] 0.67739 0.282986 [46,] -0.73555 0.432266 [47,] -0.29900 -0.388120 [48,] -0.33765 -0.343419 [49,] 0.41797 -0.233185 [50,] -0.10533 -0.530362 [51,] 0.09875 -0.532802 [52,] -0.07210 -0.541072 [53,] -0.08078 -0.538661 [54,] 0.77476 0.539827 [55,] -0.19164 -0.483800 [56,] 0.86439 0.806692 [57,] -0.99355 1.242603 [58,] 0.29956 -0.387515 [59,] 0.02027 -0.549768 [60,] 0.07609 -0.539998 [61,] 0.17531 -0.494685 [62,] -0.35927 -0.316049 [63,] -0.25677 -0.430757 [64,] -0.67219 0.270243 [65,] -0.70445 0.350903 [66,] 0.12918 -0.520202 [67,] 0.21688 -0.465075 [68,] -0.02267 -0.549581 [69,] 0.50422 -0.088698 [70,] 1.18783 2.012418 [71,] -0.35243 -0.324898 [72,] -1.45446 3.292176 [73,] 0.55481 0.008632 [74,] -0.48467 -0.123818 [75,] -0.47182 -0.146136 [76,] 0.56684 0.033125 [77,] -0.22741 -0.456577 [78,] -0.79472 0.596724 [79,] 0.05510 -0.545001 [80,] -0.13898 -0.515427 [81,] -0.05130 -0.545734 [82,] 0.17873 -0.492486 [83,] -0.27947 -0.408644 [84,] 0.33578 -0.345709 [85,] -0.18844 -0.486011 [86,] 0.14631 -0.511632 [87,] 0.61003 0.125471 [88,] 0.20898 -0.471184 [89,] -0.25236 -0.434835 [90,] 0.64153 0.197084 [91,] 0.54740 -0.006216 [92,] 0.27760 -0.410530 [93,] 0.08991 -0.535832 [94,] -0.43539 -0.206171 [95,] 0.76994 0.526306 [96,] -0.41863 -0.232167 [97,] 1.27102 2.383985 [98,] 0.87417 0.837587 [99,] -0.19766 -0.479543 [100,] -0.67695 0.281897 > > # with analytical gradients as attribute > mlGBFGS <- maxLik( llfGrad, start = startVal, method = "BFGS" ) > all.equal( mlGBFGS, mlgBFGS, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlGIndBFGS <- maxLik( llfGradInd, start = startVal, method = "BFGS" ) > all.equal( mlGIndBFGS, mlgIndBFGS, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients as argument and attribute > mlgGBFGS <- maxLik( llfGrad, gf, start = startVal, method = "BFGS" ) Warning message: In maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' > all.equal( mlgGBFGS, mlgBFGS, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGBFGS, mlGBFGS, tolerance = 1e-3 ) [1] TRUE > > # with unused Hessian > mlghBFGS <- maxLik( llf, gf, hf, start = startVal, method = "BFGS" ) > all.equal( mlgBFGS, mlghBFGS, tolerance = 1e-3 ) [1] TRUE > > # with analytical gradients and Hessian as attribute > mlGHBFGS <- maxLik( llfGradHess, start = startVal, method = "BFGS" ) > all.equal( mlGHBFGS, mlghBFGS, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients and Hessian as argument and attribute > mlgGhHBFGS <- maxLik( llfGradHess, gf, hf, start = startVal, method = "BFGS" ) Warning messages: 1: In maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' 2: In maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : the Hessian is provided both as attribute 'hessian' and as argument 'hess': ignoring argument 'hess' > all.equal( mlgGhHBFGS, mlghBFGS, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGhHBFGS, mlGHBFGS, tolerance = 1e-3 ) [1] TRUE > > > ## NM method > mlNM <- maxLik( llf, start = startVal, method = "NM" ) > print( mlNM ) Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -201.6 (2 free parameter(s)) Estimate(s): 1.181 1.817 > print( summary( mlNM ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlNM ) mu sigma TRUE TRUE > AIC( mlNM ) [1] 407.2 attr(,"df") [1] 2 > coef( mlNM ) mu sigma 1.181 1.817 > condiNumber( mlNM, digits = 3 ) mu 1 sigma 1.67 > round( hessian( mlNM ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > logLik( mlNM ) [1] -201.6 attr(,"df") [1] 2 > maximType( mlNM ) [1] "Nelder-Mead maximization" > nIter( mlNM ) function 63 > nParam( mlNM ) [1] 2 > returnCode( mlNM ) [1] 0 > returnMessage( mlNM ) [1] "successful convergence " > round( vcov( mlNM ), 3 ) mu sigma mu 0.033 0.000 sigma 0.000 0.016 > logLik( summary( mlNM ) ) [1] -201.6 attr(,"df") [1] 2 > all.equal( ml[-c(3,4,5,6,9,10)], mlNM[-c(3,4,5,6,9,10,11)], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 2.333 >" > # with individual log likelihood values > mlIndNM <- maxLik( llfInd, start = startVal, method = "NM" ) > print( summary( mlIndNM ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlNM[-4], mlIndNM[-c(4,12)], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlIndNM[12] $gradientObs mu sigma [1,] -0.39439 -0.267899 [2,] -0.19422 -0.481941 [3,] 0.88990 0.888156 [4,] -0.01200 -0.550207 [5,] 0.02363 -0.549454 [6,] 0.98465 1.210839 [7,] 0.22460 -0.458826 [8,] -0.82139 0.675189 [9,] -0.47098 -0.147497 [10,] -0.32481 -0.358808 [11,] 0.68710 0.307186 [12,] 0.16333 -0.502006 [13,] 0.18815 -0.486157 [14,] 0.01235 -0.550191 [15,] -0.39158 -0.271909 [16,] 1.02820 1.370056 [17,] 0.24699 -0.439650 [18,] -1.24656 2.272406 [19,] 0.37032 -0.301346 [20,] -0.34125 -0.338914 [21,] -0.70186 0.344421 [22,] -0.18683 -0.487060 [23,] -0.67652 0.280960 [24,] -0.49646 -0.102723 [25,] -0.43352 -0.209051 [26,] -1.07691 1.556363 [27,] 0.45300 -0.177683 [28,] 0.03822 -0.547814 [29,] -0.74447 0.456382 [30,] 0.70512 0.352759 [31,] 0.20372 -0.475072 [32,] -0.23355 -0.451379 [33,] 0.48775 -0.118297 [34,] 0.47745 -0.136353 [35,] 0.44318 -0.193672 [36,] 0.36261 -0.311606 [37,] 0.28096 -0.407062 [38,] -0.09225 -0.535009 [39,] -0.24015 -0.445699 [40,] -0.28530 -0.402597 [41,] -0.47574 -0.139311 [42,] -0.18073 -0.491130 [43,] -0.82160 0.675795 [44,] 1.25973 2.332366 [45,] 0.67733 0.282971 [46,] -0.73536 0.431898 [47,] -0.29889 -0.388181 [48,] -0.33753 -0.343500 [49,] 0.41796 -0.233126 [50,] -0.10525 -0.530344 [51,] 0.09879 -0.532738 [52,] -0.07203 -0.541043 [53,] -0.08071 -0.538635 [54,] 0.77469 0.539768 [55,] -0.19155 -0.483812 [56,] 0.86430 0.806585 [57,] -0.99332 1.241970 [58,] 0.29957 -0.387443 [59,] 0.02033 -0.549717 [60,] 0.07614 -0.539936 [61,] 0.17535 -0.494613 [62,] -0.35915 -0.316142 [63,] -0.25666 -0.430798 [64,] -0.67201 0.269930 [65,] -0.70426 0.350563 [66,] 0.12922 -0.520134 [67,] 0.21690 -0.465002 [68,] -0.02260 -0.549540 [69,] 0.50419 -0.088657 [70,] 1.18769 2.012075 [71,] -0.35231 -0.324987 [72,] -1.45415 3.290917 [73,] 0.55478 0.008659 [74,] -0.48452 -0.123988 [75,] -0.47168 -0.146298 [76,] 0.56680 0.033149 [77,] -0.22731 -0.456604 [78,] -0.79452 0.596301 [79,] 0.05515 -0.544943 [80,] -0.13890 -0.515420 [81,] -0.05123 -0.545699 [82,] 0.17876 -0.492414 [83,] -0.27936 -0.408696 [84,] 0.33578 -0.345640 [85,] -0.18835 -0.486023 [86,] 0.14634 -0.511562 [87,] 0.60999 0.125481 [88,] 0.20901 -0.471111 [89,] -0.25225 -0.434874 [90,] 0.64148 0.197083 [91,] 0.54737 -0.006186 [92,] 0.27762 -0.410457 [93,] 0.08995 -0.535769 [94,] -0.43526 -0.206309 [95,] 0.76987 0.526250 [96,] -0.41850 -0.232295 [97,] 1.27086 2.383565 [98,] 0.87408 0.837474 [99,] -0.19757 -0.479559 [100,] -0.67677 0.281580 > nObs( mlIndNM ) [1] 100 > > # with unused analytical gradients > mlgNM <- maxLik( llf, gf, start = startVal, method = "NM" ) > print( summary( mlgNM ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlNM[-4], mlgNM[-4], tolerance = 1e-3 ) [1] TRUE > # with individual log likelihood values and gradients > mlgIndNM <- maxLik( llfInd, gfInd, start = startVal, method = "NM" ) > print( summary( mlgIndNM ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlgNM[], mlgIndNM[-12], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlgIndNM[12] $gradientObs mu sigma [1,] -0.39439 -0.267899 [2,] -0.19422 -0.481941 [3,] 0.88990 0.888156 [4,] -0.01200 -0.550207 [5,] 0.02363 -0.549454 [6,] 0.98465 1.210839 [7,] 0.22460 -0.458826 [8,] -0.82139 0.675189 [9,] -0.47098 -0.147497 [10,] -0.32481 -0.358808 [11,] 0.68710 0.307186 [12,] 0.16333 -0.502006 [13,] 0.18815 -0.486157 [14,] 0.01235 -0.550191 [15,] -0.39158 -0.271909 [16,] 1.02820 1.370056 [17,] 0.24699 -0.439650 [18,] -1.24656 2.272406 [19,] 0.37032 -0.301346 [20,] -0.34125 -0.338914 [21,] -0.70186 0.344421 [22,] -0.18683 -0.487060 [23,] -0.67652 0.280960 [24,] -0.49646 -0.102723 [25,] -0.43352 -0.209051 [26,] -1.07691 1.556363 [27,] 0.45300 -0.177683 [28,] 0.03822 -0.547814 [29,] -0.74447 0.456382 [30,] 0.70512 0.352759 [31,] 0.20372 -0.475072 [32,] -0.23355 -0.451379 [33,] 0.48775 -0.118297 [34,] 0.47745 -0.136353 [35,] 0.44318 -0.193672 [36,] 0.36261 -0.311606 [37,] 0.28096 -0.407062 [38,] -0.09225 -0.535009 [39,] -0.24015 -0.445699 [40,] -0.28530 -0.402597 [41,] -0.47574 -0.139311 [42,] -0.18073 -0.491130 [43,] -0.82160 0.675795 [44,] 1.25973 2.332366 [45,] 0.67733 0.282971 [46,] -0.73536 0.431898 [47,] -0.29889 -0.388181 [48,] -0.33753 -0.343500 [49,] 0.41796 -0.233126 [50,] -0.10525 -0.530344 [51,] 0.09879 -0.532738 [52,] -0.07203 -0.541043 [53,] -0.08071 -0.538635 [54,] 0.77469 0.539768 [55,] -0.19155 -0.483812 [56,] 0.86430 0.806585 [57,] -0.99332 1.241970 [58,] 0.29957 -0.387443 [59,] 0.02033 -0.549717 [60,] 0.07614 -0.539936 [61,] 0.17535 -0.494613 [62,] -0.35915 -0.316142 [63,] -0.25666 -0.430798 [64,] -0.67201 0.269930 [65,] -0.70426 0.350563 [66,] 0.12922 -0.520134 [67,] 0.21690 -0.465002 [68,] -0.02260 -0.549540 [69,] 0.50419 -0.088657 [70,] 1.18769 2.012075 [71,] -0.35231 -0.324987 [72,] -1.45415 3.290917 [73,] 0.55478 0.008659 [74,] -0.48452 -0.123988 [75,] -0.47168 -0.146298 [76,] 0.56680 0.033149 [77,] -0.22731 -0.456604 [78,] -0.79452 0.596301 [79,] 0.05515 -0.544943 [80,] -0.13890 -0.515420 [81,] -0.05123 -0.545699 [82,] 0.17876 -0.492414 [83,] -0.27936 -0.408696 [84,] 0.33578 -0.345640 [85,] -0.18835 -0.486023 [86,] 0.14634 -0.511562 [87,] 0.60999 0.125481 [88,] 0.20901 -0.471111 [89,] -0.25225 -0.434874 [90,] 0.64148 0.197083 [91,] 0.54737 -0.006186 [92,] 0.27762 -0.410457 [93,] 0.08995 -0.535769 [94,] -0.43526 -0.206309 [95,] 0.76987 0.526250 [96,] -0.41850 -0.232295 [97,] 1.27086 2.383565 [98,] 0.87408 0.837474 [99,] -0.19757 -0.479559 [100,] -0.67677 0.281580 > > # with (unused) analytical gradients as attribute > mlGNM <- maxLik( llfGrad, start = startVal, method = "NM" ) > all.equal( mlGNM, mlgNM, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlGIndNM <- maxLik( llfGradInd, start = startVal, method = "NM" ) > all.equal( mlGIndNM, mlgIndNM, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients as argument and attribute > mlgGNM <- maxLik( llfGrad, gf, start = startVal, method = "NM" ) Warning message: In maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "Nelder-Mead", : the gradient is provided both as attribute 'gradient' and as argument 'grad': ignoring argument 'grad' > all.equal( mlgGNM, mlgNM, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlgGNM, mlGNM, tolerance = 1e-3 ) [1] TRUE > > # with unused analytical gradients and Hessian > mlghNM <- maxLik( llf, gf, hf, start = startVal, method = "NM" ) > all.equal( mlgNM, mlghNM, tolerance = 1e-3 ) [1] TRUE > > > ## SANN method > mlSANN <- maxLik( llf, start = startVal, method = "SANN" ) > print( mlSANN ) Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 (2 free parameter(s)) Estimate(s): 1.182 1.817 > print( summary( mlSANN ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlSANN ) mu sigma TRUE TRUE > AIC( mlSANN ) [1] 407.2 attr(,"df") [1] 2 > coef( mlSANN ) mu sigma 1.182 1.817 > condiNumber( mlSANN, digits = 3 ) mu 1 sigma 1.67 > round( hessian( mlSANN ), 1 ) mu sigma mu -30.3 0.0 sigma 0.0 -60.6 > logLik( mlSANN ) [1] -201.6 attr(,"df") [1] 2 > maximType( mlSANN ) [1] "SANN maximization" > nIter( mlSANN ) function 10000 > nParam( mlSANN ) [1] 2 > returnCode( mlSANN ) [1] 0 > returnMessage( mlSANN ) [1] "successful convergence " > round( vcov( mlSANN ), 3 ) mu sigma mu 0.033 0.000 sigma 0.000 0.016 > logLik( summary( mlSANN ) ) [1] -201.6 attr(,"df") [1] 2 > all.equal( ml[-c(3,4,5,6,9,10)], mlSANN[-c(3,4,5,6,9,10,11)], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 65.67 >" > # with individual log likelihood values > mlIndSANN <- maxLik( llfInd, start = startVal, method = "SANN" ) > print( summary( mlIndSANN ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlSANN[-4], mlIndSANN[-c(4,12)], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlIndSANN[12] $gradientObs mu sigma [1,] -0.39480 -0.267372 [2,] -0.19460 -0.481713 [3,] 0.88966 0.887254 [4,] -0.01235 -0.550226 [5,] 0.02327 -0.549519 [6,] 0.98443 1.209877 [7,] 0.22428 -0.459132 [8,] -0.82185 0.676448 [9,] -0.47140 -0.146848 [10,] -0.32521 -0.358388 [11,] 0.68684 0.306432 [12,] 0.16300 -0.502242 [13,] 0.18782 -0.486422 [14,] 0.01200 -0.550242 [15,] -0.39199 -0.271387 [16,] 1.02797 1.369068 [17,] 0.24666 -0.439982 [18,] -1.24707 2.274521 [19,] 0.37001 -0.301810 [20,] -0.34165 -0.338469 [21,] -0.70230 0.345462 [22,] -0.18720 -0.486842 [23,] -0.67696 0.281956 [24,] -0.49688 -0.102032 [25,] -0.43393 -0.208462 [26,] -1.07741 1.558122 [27,] 0.45270 -0.178229 [28,] 0.03787 -0.547898 [29,] -0.74492 0.457500 [30,] 0.70486 0.351991 [31,] 0.20340 -0.475355 [32,] -0.23393 -0.451095 [33,] 0.48745 -0.118877 [34,] 0.47716 -0.136923 [35,] 0.44288 -0.194209 [36,] 0.36230 -0.312062 [37,] 0.28065 -0.407431 [38,] -0.09261 -0.534923 [39,] -0.24053 -0.445405 [40,] -0.28569 -0.402236 [41,] -0.47616 -0.138654 [42,] -0.18111 -0.490921 [43,] -0.82206 0.677055 [44,] 1.25953 2.331267 [45,] 0.67707 0.282225 [46,] -0.73581 0.432999 [47,] -0.29928 -0.387800 [48,] -0.33793 -0.343061 [49,] 0.41765 -0.233638 [50,] -0.10562 -0.530239 [51,] 0.09845 -0.532897 [52,] -0.07239 -0.540984 [53,] -0.08107 -0.538564 [54,] 0.77443 0.538946 [55,] -0.19193 -0.483588 [56,] 0.86406 0.805699 [57,] -0.99380 1.243560 [58,] 0.29925 -0.387832 [59,] 0.01998 -0.549778 [60,] 0.07580 -0.540068 [61,] 0.17501 -0.494864 [62,] -0.35955 -0.315670 [63,] -0.25705 -0.430479 [64,] -0.67246 0.270919 [65,] -0.70471 0.351608 [66,] 0.12888 -0.520330 [67,] 0.21658 -0.465300 [68,] -0.02296 -0.549546 [69,] 0.50391 -0.089252 [70,] 1.18748 2.011006 [71,] -0.35271 -0.324525 [72,] -1.45469 3.293497 [73,] 0.55450 0.008018 [74,] -0.48494 -0.123317 [75,] -0.47210 -0.145648 [76,] 0.56652 0.032497 [77,] -0.22769 -0.456329 [78,] -0.79498 0.597510 [79,] 0.05480 -0.545048 [80,] -0.13927 -0.515269 [81,] -0.05159 -0.545668 [82,] 0.17843 -0.492668 [83,] -0.27975 -0.408344 [84,] 0.33547 -0.346068 [85,] -0.18873 -0.485803 [86,] 0.14601 -0.511779 [87,] 0.60971 0.124791 [88,] 0.20868 -0.471400 [89,] -0.25264 -0.434562 [90,] 0.64121 0.196366 [91,] 0.54708 -0.006821 [92,] 0.27730 -0.410822 [93,] 0.08961 -0.535917 [94,] -0.43567 -0.205717 [95,] 0.76961 0.525431 [96,] -0.41891 -0.231730 [97,] 1.27067 2.382461 [98,] 0.87384 0.836582 [99,] -0.19795 -0.479326 [100,] -0.67721 0.282577 > nObs( mlIndSANN ) [1] 100 > > # with unused analytical gradients > mlgSANN <- maxLik( llf, gf, start = startVal, method = "SANN" ) > print( summary( mlgSANN ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlSANN[-4], mlgSANN[-4], tolerance = 1e-3 ) [1] TRUE > # with individual log likelihood values and gradients > mlgIndSANN <- maxLik( llfInd, gfInd, start = startVal, method = "SANN" ) > print( summary( mlgIndSANN ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlgSANN[], mlgIndSANN[-12], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlgIndSANN[12] $gradientObs mu sigma [1,] -0.39480 -0.267372 [2,] -0.19460 -0.481713 [3,] 0.88966 0.887254 [4,] -0.01235 -0.550226 [5,] 0.02327 -0.549519 [6,] 0.98443 1.209877 [7,] 0.22428 -0.459132 [8,] -0.82185 0.676448 [9,] -0.47140 -0.146848 [10,] -0.32521 -0.358388 [11,] 0.68684 0.306432 [12,] 0.16300 -0.502242 [13,] 0.18782 -0.486422 [14,] 0.01200 -0.550242 [15,] -0.39199 -0.271387 [16,] 1.02797 1.369068 [17,] 0.24666 -0.439982 [18,] -1.24707 2.274521 [19,] 0.37001 -0.301810 [20,] -0.34165 -0.338469 [21,] -0.70230 0.345462 [22,] -0.18720 -0.486842 [23,] -0.67696 0.281956 [24,] -0.49688 -0.102032 [25,] -0.43393 -0.208462 [26,] -1.07741 1.558122 [27,] 0.45270 -0.178229 [28,] 0.03787 -0.547898 [29,] -0.74492 0.457500 [30,] 0.70486 0.351991 [31,] 0.20340 -0.475355 [32,] -0.23393 -0.451095 [33,] 0.48745 -0.118877 [34,] 0.47716 -0.136923 [35,] 0.44288 -0.194209 [36,] 0.36230 -0.312062 [37,] 0.28065 -0.407431 [38,] -0.09261 -0.534923 [39,] -0.24053 -0.445405 [40,] -0.28569 -0.402236 [41,] -0.47616 -0.138654 [42,] -0.18111 -0.490921 [43,] -0.82206 0.677055 [44,] 1.25953 2.331267 [45,] 0.67707 0.282225 [46,] -0.73581 0.432999 [47,] -0.29928 -0.387800 [48,] -0.33793 -0.343061 [49,] 0.41765 -0.233638 [50,] -0.10562 -0.530239 [51,] 0.09845 -0.532897 [52,] -0.07239 -0.540984 [53,] -0.08107 -0.538564 [54,] 0.77443 0.538946 [55,] -0.19193 -0.483588 [56,] 0.86406 0.805699 [57,] -0.99380 1.243560 [58,] 0.29925 -0.387832 [59,] 0.01998 -0.549778 [60,] 0.07580 -0.540068 [61,] 0.17501 -0.494864 [62,] -0.35955 -0.315670 [63,] -0.25705 -0.430479 [64,] -0.67246 0.270919 [65,] -0.70471 0.351608 [66,] 0.12888 -0.520330 [67,] 0.21658 -0.465300 [68,] -0.02296 -0.549546 [69,] 0.50391 -0.089252 [70,] 1.18748 2.011006 [71,] -0.35271 -0.324525 [72,] -1.45469 3.293497 [73,] 0.55450 0.008018 [74,] -0.48494 -0.123317 [75,] -0.47210 -0.145648 [76,] 0.56652 0.032497 [77,] -0.22769 -0.456329 [78,] -0.79498 0.597510 [79,] 0.05480 -0.545048 [80,] -0.13927 -0.515269 [81,] -0.05159 -0.545668 [82,] 0.17843 -0.492668 [83,] -0.27975 -0.408344 [84,] 0.33547 -0.346068 [85,] -0.18873 -0.485803 [86,] 0.14601 -0.511779 [87,] 0.60971 0.124791 [88,] 0.20868 -0.471400 [89,] -0.25264 -0.434562 [90,] 0.64121 0.196366 [91,] 0.54708 -0.006821 [92,] 0.27730 -0.410822 [93,] 0.08961 -0.535917 [94,] -0.43567 -0.205717 [95,] 0.76961 0.525431 [96,] -0.41891 -0.231730 [97,] 1.27067 2.382461 [98,] 0.87384 0.836582 [99,] -0.19795 -0.479326 [100,] -0.67721 0.282577 > > # with unused analytical gradients and Hessian > mlghSANN <- maxLik( llf, gf, hf, start = startVal, method = "SANN" ) > all.equal( mlgSANN, mlghSANN, tolerance = 1e-3 ) [1] TRUE > > # with a user-specified function to generate a new candidate point > mlSANNCand <- maxLik( llf, start = startVal, method = "SANN", + cand = function(x) c(rnorm(1, x[1]), rnorm(1, x[2])) ) > print( summary( mlSANNCand ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.20 0.18 6.6 4e-11 *** sigma 1.81 0.13 14.2 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal(coef(mlSANNCand), coef(mlSANN), tolerance = 1e-2 ) [1] TRUE > all.equal(stdEr(mlSANNCand), stdEr(mlSANN), tolerance = 1e-2 ) [1] TRUE > all.equal(hessian(mlSANNCand), hessian(mlSANN), tolerance = 1e-2 ) [1] "Mean relative difference: 0.022" > > > ## CG method > # Estimate with only function values (aggregated) > mlCg <- maxLik( llf, start = startVal, method = "CG" ) > print(summary( mlCg)) -------------------------------------------- Maximum Likelihood estimation CG maximization, 75 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.181 0.182 6.5 7.9e-11 *** sigma 1.816 0.128 14.1 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > # Estimate with analytic gradient (aggregated) > mlgCg <- maxLik( llf, gf, start = startVal, method = "CG" ) > print(summary( mlgCg)) -------------------------------------------- Maximum Likelihood estimation CG maximization, 78 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.181 0.182 6.5 8e-11 *** sigma 1.816 0.128 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > # Estimate with analytic gradient (aggregated) and Hessian (not used for estimation) > mlghCg <- maxLik( llf, gf, hf, start = startVal, method = "CG" ) > print(summary( mlghCg)) -------------------------------------------- Maximum Likelihood estimation CG maximization, 78 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.181 0.182 6.5 8e-11 *** sigma 1.816 0.128 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > ## > # Estimate with only function values (individual) > mlCg <- maxLik( llf, start = startVal, method = "CG" ) > print(summary( mlCg)) -------------------------------------------- Maximum Likelihood estimation CG maximization, 75 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.181 0.182 6.5 7.9e-11 *** sigma 1.816 0.128 14.1 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > # Estimate with analytic gradient (individual) > mlgCg <- maxLik( llf, gf, start = startVal, method = "CG" ) > print(summary( mlgCg)) -------------------------------------------- Maximum Likelihood estimation CG maximization, 78 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.181 0.182 6.5 8e-11 *** sigma 1.816 0.128 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > # Estimate with analytic gradient (individual) and Hessian (not used for estimation) > mlghCg <- maxLik( llfInd, gfInd, hf, start = startVal, method = "CG" ) > print(summary( mlghCg)) -------------------------------------------- Maximum Likelihood estimation CG maximization, 75 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.181 0.182 6.5 8e-11 *** sigma 1.816 0.128 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > > > ############### with fixed parameters ############### > # start values > startValFix <- c( mu = 1, sigma = 1 ) > > # fix mu (the mean ) at its start value > isFixed <- c( TRUE, FALSE ) > > ## NR method with fixed parameters > mlFix <- maxLik( llf, start = startValFix, activePar = !isFixed ) > mlFix1 <- maxLik( llf, start = startValFix, activePar = 2 ) > all.equal( mlFix, mlFix1, tolerance = 1e-3 ) [1] TRUE > mlFix2 <- maxLik( llf, start = startValFix, fixed = isFixed ) > all.equal( mlFix, mlFix2, tolerance = 1e-3 ) [1] TRUE > mlFix3 <- maxLik( llf, start = startValFix, fixed = "mu" ) > all.equal( mlFix, mlFix3, tolerance = 1e-3 ) [1] TRUE > mlFix4 <- maxLik( llf, start = startValFix, fixed = 1 ) > all.equal( mlFix, mlFix4, tolerance = 1e-3 ) [1] TRUE > print( mlFix ) Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 (1 free parameter(s)) Estimate(s): 1 1.825 > print( summary( mlFix ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlFix ) mu sigma FALSE TRUE > AIC( mlFix ) [1] 406.2 attr(,"df") [1] 1 > coef( mlFix ) mu sigma 1.000 1.825 > condiNumber( mlFix, digits = 3 ) sigma 1 > round( hessian( mlFix ), 1 ) mu sigma mu NA NA sigma NA -60 > logLik( mlFix ) [1] -202.1 attr(,"df") [1] 1 > maximType( mlFix ) [1] "Newton-Raphson maximisation" > nIter( mlFix ) [1] 6 > nParam( mlFix ) [1] 2 > returnCode( mlFix ) [1] 2 > returnMessage( mlFix ) [1] "successive function values within tolerance limit" > round( vcov( mlFix ), 3 ) mu sigma mu 0 0.000 sigma 0 0.017 > logLik( summary( mlFix ) ) [1] -202.1 attr(,"df") [1] 1 > mlIndFix <- maxLik( llfInd, start = startValFix, activePar = !isFixed ) > mlIndFix1 <- maxLik( llfInd, start = startValFix, activePar = 2 ) > all.equal( mlIndFix, mlIndFix1, tolerance = 1e-3 ) [1] TRUE > mlIndFix2 <- maxLik( llfInd, start = startValFix, fixed = isFixed ) > all.equal( mlIndFix, mlIndFix2, tolerance = 1e-3 ) [1] TRUE > mlIndFix3 <- maxLik( llfInd, start = startValFix, fixed = "mu" ) > all.equal( mlIndFix, mlIndFix3, tolerance = 1e-3 ) [1] TRUE > mlIndFix4 <- maxLik( llfInd, start = startValFix, fixed = 1 ) > all.equal( mlIndFix, mlIndFix4, tolerance = 1e-3 ) [1] TRUE > print( summary( mlIndFix ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlFix[ ], mlIndFix[ -11 ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlFix[[3]], 5 ) mu sigma NA 0 > round( mlIndFix[[3]], 5 ) mu sigma NA 1e-05 > round( mlIndFix[[ 11 ]], 3 ) mu sigma [1,] NA -0.341 [2,] NA -0.513 [3,] NA 1.050 [4,] NA -0.545 [5,] NA -0.537 [6,] NA 1.386 [7,] NA -0.408 [8,] NA 0.505 [9,] NA -0.238 [10,] NA -0.417 [11,] NA 0.437 [12,] NA -0.463 [13,] NA -0.442 [14,] NA -0.540 [15,] NA -0.345 [16,] NA 1.552 [17,] NA -0.385 [18,] NA 1.995 [19,] NA -0.224 [20,] NA -0.401 [21,] NA 0.202 [22,] NA -0.517 [23,] NA 0.144 [24,] NA -0.198 [25,] NA -0.291 [26,] NA 1.323 [27,] NA -0.086 [28,] NA -0.532 [29,] NA 0.304 [30,] NA 0.486 [31,] NA -0.428 [32,] NA -0.491 [33,] NA -0.021 [34,] NA -0.041 [35,] NA -0.104 [36,] NA -0.236 [37,] NA -0.346 [38,] NA -0.545 [39,] NA -0.486 [40,] NA -0.453 [41,] NA -0.230 [42,] NA -0.519 [43,] NA 0.505 [44,] NA 2.546 [45,] NA 0.412 [46,] NA 0.282 [47,] NA -0.441 [48,] NA -0.405 [49,] NA -0.148 [50,] NA -0.543 [51,] NA -0.506 [52,] NA -0.547 [53,] NA -0.547 [54,] NA 0.684 [55,] NA -0.514 [56,] NA 0.964 [57,] NA 1.029 [58,] NA -0.323 [59,] NA -0.538 [60,] NA -0.517 [61,] NA -0.453 [62,] NA -0.382 [63,] NA -0.475 [64,] NA 0.134 [65,] NA 0.208 [66,] NA -0.487 [67,] NA -0.416 [68,] NA -0.546 [69,] NA 0.012 [70,] NA 2.216 [71,] NA -0.389 [72,] NA 2.959 [73,] NA 0.117 [74,] NA -0.217 [75,] NA -0.237 [76,] NA 0.144 [77,] NA -0.494 [78,] NA 0.432 [79,] NA -0.526 [80,] NA -0.535 [81,] NA -0.548 [82,] NA -0.450 [83,] NA -0.457 [84,] NA -0.275 [85,] NA -0.516 [86,] NA -0.475 [87,] NA 0.243 [88,] NA -0.423 [89,] NA -0.478 [90,] NA 0.320 [91,] NA 0.101 [92,] NA -0.350 [93,] NA -0.510 [94,] NA -0.289 [95,] NA 0.670 [96,] NA -0.311 [97,] NA 2.598 [98,] NA 0.997 [99,] NA -0.511 [100,] NA 0.145 > nObs( mlIndFix ) [1] 100 > > # with analytical gradients > mlgFix <- maxLik( llf, gf, start = startValFix, activePar = !isFixed ) > mlgFix1 <- maxLik( llf, gf, start = startValFix, activePar = 2 ) > all.equal( mlgFix, mlgFix1, tolerance = 1e-3 ) [1] TRUE > mlgFix2 <- maxLik( llf, gf, start = startValFix, fixed = isFixed ) > all.equal( mlgFix, mlgFix2, tolerance = 1e-3 ) [1] TRUE > print( summary( mlgFix ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlgIndFix <- maxLik( llfInd, gfInd, start = startValFix, activePar = !isFixed ) > all.equal( mlIndFix, mlgIndFix, tolerance = 1e-3 ) [1] TRUE > all.equal( mlgFix[ ], mlgIndFix[ -11 ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgIndFix[[ 11 ]], 3 ) mu sigma [1,] NA -0.341 [2,] NA -0.513 [3,] NA 1.050 [4,] NA -0.545 [5,] NA -0.537 [6,] NA 1.386 [7,] NA -0.408 [8,] NA 0.505 [9,] NA -0.238 [10,] NA -0.417 [11,] NA 0.437 [12,] NA -0.463 [13,] NA -0.442 [14,] NA -0.540 [15,] NA -0.345 [16,] NA 1.552 [17,] NA -0.385 [18,] NA 1.995 [19,] NA -0.224 [20,] NA -0.401 [21,] NA 0.202 [22,] NA -0.517 [23,] NA 0.144 [24,] NA -0.198 [25,] NA -0.291 [26,] NA 1.323 [27,] NA -0.086 [28,] NA -0.532 [29,] NA 0.304 [30,] NA 0.486 [31,] NA -0.428 [32,] NA -0.491 [33,] NA -0.021 [34,] NA -0.041 [35,] NA -0.104 [36,] NA -0.236 [37,] NA -0.346 [38,] NA -0.545 [39,] NA -0.486 [40,] NA -0.453 [41,] NA -0.230 [42,] NA -0.519 [43,] NA 0.505 [44,] NA 2.546 [45,] NA 0.412 [46,] NA 0.282 [47,] NA -0.441 [48,] NA -0.405 [49,] NA -0.148 [50,] NA -0.543 [51,] NA -0.506 [52,] NA -0.547 [53,] NA -0.547 [54,] NA 0.684 [55,] NA -0.514 [56,] NA 0.964 [57,] NA 1.029 [58,] NA -0.323 [59,] NA -0.538 [60,] NA -0.517 [61,] NA -0.453 [62,] NA -0.382 [63,] NA -0.475 [64,] NA 0.134 [65,] NA 0.208 [66,] NA -0.487 [67,] NA -0.416 [68,] NA -0.546 [69,] NA 0.012 [70,] NA 2.216 [71,] NA -0.389 [72,] NA 2.959 [73,] NA 0.117 [74,] NA -0.217 [75,] NA -0.237 [76,] NA 0.144 [77,] NA -0.494 [78,] NA 0.432 [79,] NA -0.526 [80,] NA -0.535 [81,] NA -0.548 [82,] NA -0.450 [83,] NA -0.457 [84,] NA -0.275 [85,] NA -0.516 [86,] NA -0.475 [87,] NA 0.243 [88,] NA -0.423 [89,] NA -0.478 [90,] NA 0.320 [91,] NA 0.101 [92,] NA -0.350 [93,] NA -0.510 [94,] NA -0.289 [95,] NA 0.670 [96,] NA -0.311 [97,] NA 2.598 [98,] NA 0.997 [99,] NA -0.511 [100,] NA 0.145 > > # with analytical gradients and Hessians > mlghFix <- maxLik( llf, gf, hf, start = startValFix, activePar = !isFixed ) > all.equal( mlgFix, mlghFix, tolerance = 1e-3 ) [1] TRUE > mlgFix[[4]] mu sigma mu NA NA sigma NA -60.02 > mlghFix[[4]] mu sigma mu NA NA sigma NA -60.02 > > ## BHHH method with fixed parameters > mlFixBHHH <- maxLik( llfInd, start = startValFix, activePar = !isFixed, + method = "BHHH" ) > mlFixBHHH1 <- maxLik( llfInd, start = startValFix, activePar = 2, + method = "BHHH" ) > all.equal( mlFixBHHH, mlFixBHHH1, tolerance = 1e-3 ) [1] TRUE > mlFixBHHH2 <- maxLik( llfInd, start = startValFix, fixed = isFixed, + method = "BHHH" ) > all.equal( mlFixBHHH, mlFixBHHH2, tolerance = 1e-3 ) [1] TRUE > mlFixBHHH3 <- maxLik( llfInd, start = startValFix, fixed = "mu", + method = "BHHH" ) > all.equal( mlFixBHHH, mlFixBHHH3, tolerance = 1e-3 ) [1] TRUE > mlFixBHHH4 <- maxLik( llfInd, start = startValFix, fixed = 1, + method = "BHHH" ) > all.equal( mlFixBHHH, mlFixBHHH4, tolerance = 1e-3 ) [1] TRUE > print( mlFixBHHH ) Maximum Likelihood estimation BHHH maximisation, 9 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 (1 free parameter(s)) Estimate(s): 1 1.825 > print( summary( mlFixBHHH ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 9 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlFixBHHH ) mu sigma FALSE TRUE > AIC( mlFixBHHH ) [1] 406.2 attr(,"df") [1] 1 > coef( mlFixBHHH ) mu sigma 1.000 1.825 > condiNumber( mlFixBHHH, digits = 3 ) sigma 1 > round( hessian( mlFixBHHH ), 1 ) mu sigma mu NA NA sigma NA -56 attr(,"type") [1] "BHHH" > logLik( mlFixBHHH ) [1] -202.1 attr(,"df") [1] 1 > maximType( mlFixBHHH ) [1] "BHHH maximisation" > nIter( mlFixBHHH ) [1] 9 > nParam( mlFixBHHH ) [1] 2 > returnCode( mlFixBHHH ) [1] 2 > returnMessage( mlFixBHHH ) [1] "successive function values within tolerance limit" > round( vcov( mlFixBHHH ), 3 ) mu sigma mu 0 0.000 sigma 0 0.018 > logLik( summary( mlFixBHHH ) ) [1] -202.1 attr(,"df") [1] 1 > all.equal( mlFix[ -c( 4, 5, 6, 9, 10 ) ], mlFixBHHH[ -c( 4, 5, 6, 9, 10, 11 ) ], + tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlFixBHHH[[ 11 ]], 3 ) mu sigma [1,] NA -0.341 [2,] NA -0.513 [3,] NA 1.050 [4,] NA -0.545 [5,] NA -0.537 [6,] NA 1.386 [7,] NA -0.408 [8,] NA 0.505 [9,] NA -0.238 [10,] NA -0.417 [11,] NA 0.437 [12,] NA -0.463 [13,] NA -0.442 [14,] NA -0.540 [15,] NA -0.345 [16,] NA 1.552 [17,] NA -0.385 [18,] NA 1.995 [19,] NA -0.224 [20,] NA -0.401 [21,] NA 0.202 [22,] NA -0.517 [23,] NA 0.144 [24,] NA -0.198 [25,] NA -0.291 [26,] NA 1.323 [27,] NA -0.086 [28,] NA -0.532 [29,] NA 0.304 [30,] NA 0.486 [31,] NA -0.428 [32,] NA -0.491 [33,] NA -0.021 [34,] NA -0.041 [35,] NA -0.104 [36,] NA -0.236 [37,] NA -0.346 [38,] NA -0.545 [39,] NA -0.486 [40,] NA -0.453 [41,] NA -0.230 [42,] NA -0.519 [43,] NA 0.505 [44,] NA 2.546 [45,] NA 0.412 [46,] NA 0.282 [47,] NA -0.441 [48,] NA -0.405 [49,] NA -0.148 [50,] NA -0.543 [51,] NA -0.506 [52,] NA -0.547 [53,] NA -0.547 [54,] NA 0.684 [55,] NA -0.514 [56,] NA 0.964 [57,] NA 1.029 [58,] NA -0.323 [59,] NA -0.538 [60,] NA -0.517 [61,] NA -0.453 [62,] NA -0.382 [63,] NA -0.475 [64,] NA 0.134 [65,] NA 0.208 [66,] NA -0.487 [67,] NA -0.416 [68,] NA -0.546 [69,] NA 0.012 [70,] NA 2.216 [71,] NA -0.389 [72,] NA 2.959 [73,] NA 0.117 [74,] NA -0.217 [75,] NA -0.237 [76,] NA 0.144 [77,] NA -0.494 [78,] NA 0.432 [79,] NA -0.526 [80,] NA -0.535 [81,] NA -0.548 [82,] NA -0.450 [83,] NA -0.457 [84,] NA -0.275 [85,] NA -0.516 [86,] NA -0.475 [87,] NA 0.243 [88,] NA -0.423 [89,] NA -0.478 [90,] NA 0.320 [91,] NA 0.101 [92,] NA -0.350 [93,] NA -0.510 [94,] NA -0.289 [95,] NA 0.670 [96,] NA -0.311 [97,] NA 2.598 [98,] NA 0.997 [99,] NA -0.511 [100,] NA 0.145 > nObs( mlFixBHHH ) [1] 100 > > # with analytical gradients > mlgFixBHHH <- maxLik( llfInd, gfInd, start = startValFix, activePar = !isFixed, + method = "BHHH" ) > mlgFixBHHH1 <- maxLik( llfInd, gfInd, start = startValFix, activePar = 2, + method = "BHHH" ) > all.equal( mlgFixBHHH, mlgFixBHHH1, tolerance = 1e-3 ) [1] TRUE > mlgFixBHHH2 <- maxLik( llfInd, gfInd, start = startValFix, fixed = isFixed, + method = "BHHH" ) > all.equal( mlgFixBHHH, mlgFixBHHH2, tolerance = 1e-3 ) [1] TRUE > mlgFixBHHH3 <- maxLik( llfInd, gfInd, start = startValFix, fixed = "mu", + method = "BHHH" ) > all.equal( mlgFixBHHH, mlgFixBHHH3, tolerance = 1e-3 ) [1] TRUE > mlgFixBHHH4 <- maxLik( llfInd, gfInd, start = startValFix, fixed = 1, + method = "BHHH" ) > all.equal( mlgFixBHHH, mlgFixBHHH4, tolerance = 1e-3 ) [1] TRUE > print( summary( mlgFixBHHH ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 9 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlFixBHHH, mlgFixBHHH, tolerance = 1e-3 ) [1] TRUE > mlgFixBHHH2 <- maxLik( llf, gfInd, start = startValFix, activePar = !isFixed, + method = "BHHH") > all.equal( mlgFixBHHH, mlgFixBHHH2, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with unused Hessians > mlghFixBHHH <- maxLik( llfInd, gfInd, hf, start = startValFix, activePar = !isFixed, + method = "BHHH" ) > all.equal( mlgFixBHHH, mlghFixBHHH, tolerance = 1e-3 ) [1] TRUE > > ## BFGS method with fixed parameters > mlFixBfgs <- maxLik( llf, start = startValFix, fixed = isFixed, + method = "BFGS" ) > mlFixBfgs3 <- maxLik( llf, start = startValFix, fixed = "mu", + method = "BFGS" ) > all.equal( mlFixBfgs, mlFixBfgs3, tolerance = 1e-3 ) [1] TRUE > mlFixBfgs4 <- maxLik( llf, start = startValFix, fixed = 1, + method = "BFGS" ) > all.equal( mlFixBfgs, mlFixBfgs4, tolerance = 1e-3 ) [1] TRUE > print( mlFixBfgs ) Maximum Likelihood estimation BFGS maximization, 27 iterations Return code 0: successful convergence Log-Likelihood: -202.1 (1 free parameter(s)) Estimate(s): 1 1.825 > print( summary( mlFixBfgs ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 27 iterations Return code 0: successful convergence Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlFixBfgs ) mu sigma FALSE TRUE > AIC( mlFixBfgs ) [1] 406.2 attr(,"df") [1] 1 > coef( mlFixBfgs ) mu sigma 1.000 1.825 > condiNumber( mlFixBfgs, digits = 3 ) sigma 1 > round( hessian( mlFixBfgs ), 1 ) mu sigma mu -30.0 -5.9 sigma -5.9 -60.0 > logLik( mlFixBfgs ) [1] -202.1 attr(,"df") [1] 1 > maximType( mlFixBfgs ) [1] "BFGS maximization" > nIter( mlFixBfgs ) function 27 > nParam( mlFixBfgs ) [1] 2 > returnCode( mlFixBfgs ) [1] 0 > returnMessage( mlFixBfgs ) [1] "successful convergence " > round( vcov( mlFixBfgs ), 3 ) mu sigma mu 0 0.000 sigma 0 0.017 > logLik( summary( mlFixBfgs ) ) [1] -202.1 attr(,"df") [1] 1 > all.equal( mlghFix[ -c( 5, 6, 9, 10 ) ], mlFixBfgs[ -c( 5, 6, 9, 10, 11 ) ], + tolerance = 1e-3 ) [1] "Component \"gradient\": 'is.NA' value mismatch: 0 in current 1 in target" [2] "Component \"hessian\": 'is.NA' value mismatch: 0 in current 3 in target" [3] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 0.3333 >" > mlIndFixBfgs <- maxLik( llfInd, start = startValFix, fixed = isFixed, + method = "BFGS" ) > all.equal( mlFixBfgs[-c(4,9)], mlIndFixBfgs[ -c(4,9,12) ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > print(formatC(mlIndFixBfgs$gradientObs, format="f", digits=4, width=7), quote=FALSE) mu sigma [1,] -0.3364 -0.3412 [2,] -0.1381 -0.5130 [3,] 0.9355 1.0498 [4,] 0.0423 -0.5445 [5,] 0.0776 -0.5368 [6,] 1.0294 1.3864 [7,] 0.2766 -0.4081 [8,] -0.7593 0.5046 [9,] -0.4122 -0.2376 [10,] -0.2675 -0.4172 [11,] 0.7347 0.4375 [12,] 0.2160 -0.4627 [13,] 0.2405 -0.4422 [14,] 0.0664 -0.5398 [15,] -0.3336 -0.3446 [16,] 1.0725 1.5519 [17,] 0.2988 -0.3848 [18,] -1.1803 1.9954 [19,] 0.4209 -0.2243 [20,] -0.2838 -0.4008 [21,] -0.6409 0.2020 [22,] -0.1308 -0.5166 [23,] -0.6158 0.1444 [24,] -0.4375 -0.1985 [25,] -0.3751 -0.2909 [26,] -1.0123 1.3229 [27,] 0.5028 -0.0863 [28,] 0.0921 -0.5323 [29,] -0.6831 0.3040 [30,] 0.7525 0.4859 [31,] 0.2560 -0.4282 [32,] -0.1771 -0.4906 [33,] 0.5372 -0.0209 [34,] 0.5270 -0.0407 [35,] 0.4931 -0.1039 [36,] 0.4133 -0.2360 [37,] 0.3325 -0.3460 [38,] -0.0372 -0.5453 [39,] -0.1836 -0.4863 [40,] -0.2284 -0.4526 [41,] -0.4170 -0.2305 [42,] -0.1248 -0.5194 [43,] -0.7595 0.5051 [44,] 1.3018 2.5457 [45,] 0.7250 0.4117 [46,] -0.6741 0.2816 [47,] -0.2418 -0.4411 [48,] -0.2801 -0.4046 [49,] 0.4681 -0.1478 [50,] -0.0500 -0.5432 [51,] 0.1520 -0.5056 [52,] -0.0171 -0.5473 [53,] -0.0257 -0.5466 [54,] 0.8214 0.6839 [55,] -0.1355 -0.5143 [56,] 0.9102 0.9644 [57,] -0.9295 1.0295 [58,] 0.3509 -0.3231 [59,] 0.0743 -0.5377 [60,] 0.1296 -0.5171 [61,] 0.2279 -0.4530 [62,] -0.3015 -0.3819 [63,] -0.2000 -0.4748 [64,] -0.6113 0.1344 [65,] -0.6433 0.2076 [66,] 0.1822 -0.4872 [67,] 0.2690 -0.4157 [68,] 0.0318 -0.5460 [69,] 0.5535 0.0115 [70,] 1.2304 2.2159 [71,] -0.2947 -0.3893 [72,] -1.3859 2.9585 [73,] 0.6036 0.1173 [74,] -0.4257 -0.2171 [75,] -0.4129 -0.2365 [76,] 0.6155 0.1438 [77,] -0.1709 -0.4945 [78,] -0.7327 0.4321 [79,] 0.1088 -0.5262 [80,] -0.0834 -0.5351 [81,] 0.0035 -0.5478 [82,] 0.2312 -0.4502 [83,] -0.2225 -0.4575 [84,] 0.3867 -0.2748 [85,] -0.1323 -0.5158 [86,] 0.1991 -0.4754 [87,] 0.6583 0.2433 [88,] 0.2612 -0.4233 [89,] -0.1956 -0.4780 [90,] 0.6895 0.3200 [91,] 0.5963 0.1013 [92,] 0.3291 -0.3500 [93,] 0.1433 -0.5103 [94,] -0.3769 -0.2885 [95,] 0.8166 0.6696 [96,] -0.3603 -0.3109 [97,] 1.3128 2.5983 [98,] 0.9199 0.9968 [99,] -0.1415 -0.5113 [100,] -0.6160 0.1450 > # print fradient, only 4 digits to avoid clutter in R CMD tests > mlIndFixBfgs3 <- maxLik( llfInd, start = startValFix, fixed = "mu", + method = "BFGS" ) > all.equal( mlIndFixBfgs, mlIndFixBfgs3, tolerance = 1e-3 ) [1] TRUE > mlIndFixBfgs4 <- maxLik( llfInd, start = startValFix, fixed = 1, + method = "BFGS" ) > all.equal( mlIndFixBfgs, mlIndFixBfgs4, tolerance = 1e-3 ) [1] TRUE > nObs( mlIndFixBfgs ) [1] 100 > > # with analytical gradients > mlgFixBfgs <- maxLik( llf, gf, start = startValFix, fixed = isFixed, + method = "BFGS" ) > mlgFixBfgs3 <- maxLik( llf, gf, start = startValFix, fixed = "mu", + method = "BFGS" ) > all.equal( mlgFixBfgs, mlgFixBfgs3, tolerance = 1e-3 ) [1] TRUE > mlgFixBfgs4 <- maxLik( llf, gf, start = startValFix, fixed = 1, + method = "BFGS" ) > all.equal( mlgFixBfgs, mlgFixBfgs4, tolerance = 1e-3 ) [1] TRUE > print( summary( mlgFixBfgs ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 27 iterations Return code 0: successful convergence Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlFixBfgs[ -9 ], mlgFixBfgs[ -9 ], tolerance = 1e-3 ) [1] TRUE > mlgIndFixBfgs <- maxLik( llfInd, gfInd, start = startValFix, fixed = isFixed, + method = "BFGS") > all.equal( mlgFixBfgs[ ], mlgIndFixBfgs[ -12 ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgIndFixBfgs[[ 12 ]], 3 ) mu sigma [1,] -0.336 -0.341 [2,] -0.138 -0.513 [3,] 0.936 1.050 [4,] 0.042 -0.545 [5,] 0.078 -0.537 [6,] 1.029 1.386 [7,] 0.277 -0.408 [8,] -0.759 0.505 [9,] -0.412 -0.238 [10,] -0.267 -0.417 [11,] 0.735 0.437 [12,] 0.216 -0.463 [13,] 0.241 -0.442 [14,] 0.066 -0.540 [15,] -0.334 -0.345 [16,] 1.072 1.552 [17,] 0.299 -0.385 [18,] -1.180 1.995 [19,] 0.421 -0.224 [20,] -0.284 -0.401 [21,] -0.641 0.202 [22,] -0.131 -0.517 [23,] -0.616 0.144 [24,] -0.437 -0.198 [25,] -0.375 -0.291 [26,] -1.012 1.323 [27,] 0.503 -0.086 [28,] 0.092 -0.532 [29,] -0.683 0.304 [30,] 0.753 0.486 [31,] 0.256 -0.428 [32,] -0.177 -0.491 [33,] 0.537 -0.021 [34,] 0.527 -0.041 [35,] 0.493 -0.104 [36,] 0.413 -0.236 [37,] 0.332 -0.346 [38,] -0.037 -0.545 [39,] -0.184 -0.486 [40,] -0.228 -0.453 [41,] -0.417 -0.230 [42,] -0.125 -0.519 [43,] -0.759 0.505 [44,] 1.302 2.546 [45,] 0.725 0.412 [46,] -0.674 0.282 [47,] -0.242 -0.441 [48,] -0.280 -0.405 [49,] 0.468 -0.148 [50,] -0.050 -0.543 [51,] 0.152 -0.506 [52,] -0.017 -0.547 [53,] -0.026 -0.547 [54,] 0.821 0.684 [55,] -0.136 -0.514 [56,] 0.910 0.964 [57,] -0.930 1.029 [58,] 0.351 -0.323 [59,] 0.074 -0.538 [60,] 0.130 -0.517 [61,] 0.228 -0.453 [62,] -0.301 -0.382 [63,] -0.200 -0.475 [64,] -0.611 0.134 [65,] -0.643 0.208 [66,] 0.182 -0.487 [67,] 0.269 -0.416 [68,] 0.032 -0.546 [69,] 0.554 0.012 [70,] 1.230 2.216 [71,] -0.295 -0.389 [72,] -1.386 2.959 [73,] 0.604 0.117 [74,] -0.426 -0.217 [75,] -0.413 -0.237 [76,] 0.616 0.144 [77,] -0.171 -0.494 [78,] -0.733 0.432 [79,] 0.109 -0.526 [80,] -0.083 -0.535 [81,] 0.003 -0.548 [82,] 0.231 -0.450 [83,] -0.222 -0.457 [84,] 0.387 -0.275 [85,] -0.132 -0.516 [86,] 0.199 -0.475 [87,] 0.658 0.243 [88,] 0.261 -0.423 [89,] -0.196 -0.478 [90,] 0.689 0.320 [91,] 0.596 0.101 [92,] 0.329 -0.350 [93,] 0.143 -0.510 [94,] -0.377 -0.289 [95,] 0.817 0.670 [96,] -0.360 -0.311 [97,] 1.313 2.598 [98,] 0.920 0.997 [99,] -0.141 -0.511 [100,] -0.616 0.145 > mlgIndFixBfgs3 <- maxLik( llfInd, gfInd, start = startValFix, fixed = "mu", + method = "BFGS" ) > all.equal( mlgIndFixBfgs, mlgIndFixBfgs3, tolerance = 1e-3 ) [1] TRUE > mlgIndFixBfgs4 <- maxLik( llfInd, gfInd, start = startValFix, fixed = 1, + method = "BFGS" ) > all.equal( mlgIndFixBfgs, mlgIndFixBfgs4, tolerance = 1e-3 ) [1] TRUE > > # with unused Hessians > mlghFixBfgs <- maxLik( llf, gf, hf, start = startValFix, fixed = isFixed, + method = "BFGS" ) > all.equal( mlgFixBfgs, mlghFixBfgs, tolerance = 1e-3 ) [1] TRUE > mlghFixBfgs3 <- maxLik( llf, gf, hf, start = startValFix, fixed = "mu", + method = "BFGS" ) > all.equal( mlghFixBfgs, mlghFixBfgs3, tolerance = 1e-3 ) [1] TRUE > mlghFixBfgs4 <- maxLik( llf, gf, hf, start = startValFix, fixed = 1, + method = "BFGS" ) > all.equal( mlghFixBfgs, mlghFixBfgs4, tolerance = 1e-3 ) [1] TRUE > > ## NM method with fixed parameters > mlFixNm <- maxLik( llf, start = startValFix, fixed = isFixed, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > mlFixNm3 <- maxLik( llf, start = startValFix, fixed = "mu", + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlFixNm, mlFixNm3, tolerance = 1e-3 ) [1] TRUE > mlFixNm4 <- maxLik( llf, start = startValFix, fixed = 1, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlFixNm, mlFixNm4, tolerance = 1e-3 ) [1] TRUE > print( mlFixNm ) Maximum Likelihood estimation Nelder-Mead maximization, 24 iterations Return code 0: successful convergence Log-Likelihood: -202.1 (1 free parameter(s)) Estimate(s): 1 1.826 > print( summary( mlFixNm ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 24 iterations Return code 0: successful convergence Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlFixNm ) mu sigma FALSE TRUE > AIC( mlFixNm ) [1] 406.2 attr(,"df") [1] 1 > coef( mlFixNm ) mu sigma 1.000 1.826 > condiNumber( mlFixNm, digits = 3 ) sigma 1 > round( hessian( mlFixNm ), 1 ) mu sigma mu -30 -6 sigma -6 -60 > logLik( mlFixNm ) [1] -202.1 attr(,"df") [1] 1 > maximType( mlFixNm ) [1] "Nelder-Mead maximization" > nIter( mlFixNm ) function 24 > nParam( mlFixNm ) [1] 2 > returnCode( mlFixNm ) [1] 0 > returnMessage( mlFixNm ) [1] "successful convergence " > round( vcov( mlFixNm ), 3 ) mu sigma mu 0 0.000 sigma 0 0.017 > logLik( summary( mlFixNm ) ) [1] -202.1 attr(,"df") [1] 1 > all.equal( mlFixBfgs[ -c(4,9,10) ], mlFixNm[ -c(4,9,10) ], tolerance = 1e-3 ) [1] "Component \"gradient\": Mean relative difference: 0.003935" [2] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 1.5 >" > mlIndFixNm <- maxLik( llfInd, start = startValFix, fixed = isFixed, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlFixNm[-4], mlIndFixNm[-c(4,12)], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlIndFixNm[[ 12 ]], 3 ) mu sigma [1,] -0.336 -0.341 [2,] -0.138 -0.513 [3,] 0.935 1.049 [4,] 0.042 -0.544 [5,] 0.078 -0.537 [6,] 1.029 1.385 [7,] 0.277 -0.408 [8,] -0.759 0.504 [9,] -0.412 -0.238 [10,] -0.267 -0.417 [11,] 0.734 0.437 [12,] 0.216 -0.463 [13,] 0.240 -0.442 [14,] 0.066 -0.540 [15,] -0.333 -0.345 [16,] 1.072 1.551 [17,] 0.299 -0.385 [18,] -1.180 1.994 [19,] 0.421 -0.224 [20,] -0.284 -0.401 [21,] -0.641 0.202 [22,] -0.131 -0.516 [23,] -0.616 0.144 [24,] -0.437 -0.199 [25,] -0.375 -0.291 [26,] -1.012 1.322 [27,] 0.503 -0.086 [28,] 0.092 -0.532 [29,] -0.683 0.304 [30,] 0.752 0.485 [31,] 0.256 -0.428 [32,] -0.177 -0.490 [33,] 0.537 -0.021 [34,] 0.527 -0.041 [35,] 0.493 -0.104 [36,] 0.413 -0.236 [37,] 0.332 -0.346 [38,] -0.037 -0.545 [39,] -0.184 -0.486 [40,] -0.228 -0.453 [41,] -0.417 -0.231 [42,] -0.125 -0.519 [43,] -0.759 0.505 [44,] 1.301 2.544 [45,] 0.725 0.411 [46,] -0.674 0.281 [47,] -0.242 -0.441 [48,] -0.280 -0.405 [49,] 0.468 -0.148 [50,] -0.050 -0.543 [51,] 0.152 -0.506 [52,] -0.017 -0.547 [53,] -0.026 -0.547 [54,] 0.821 0.683 [55,] -0.135 -0.514 [56,] 0.910 0.964 [57,] -0.929 1.029 [58,] 0.351 -0.323 [59,] 0.074 -0.538 [60,] 0.130 -0.517 [61,] 0.228 -0.453 [62,] -0.301 -0.382 [63,] -0.200 -0.475 [64,] -0.611 0.134 [65,] -0.643 0.207 [66,] 0.182 -0.487 [67,] 0.269 -0.416 [68,] 0.032 -0.546 [69,] 0.553 0.011 [70,] 1.230 2.215 [71,] -0.295 -0.389 [72,] -1.385 2.957 [73,] 0.603 0.117 [74,] -0.426 -0.217 [75,] -0.413 -0.237 [76,] 0.615 0.144 [77,] -0.171 -0.494 [78,] -0.732 0.432 [79,] 0.109 -0.526 [80,] -0.083 -0.535 [81,] 0.003 -0.548 [82,] 0.231 -0.450 [83,] -0.222 -0.457 [84,] 0.387 -0.275 [85,] -0.132 -0.516 [86,] 0.199 -0.475 [87,] 0.658 0.243 [88,] 0.261 -0.423 [89,] -0.196 -0.478 [90,] 0.689 0.320 [91,] 0.596 0.101 [92,] 0.329 -0.350 [93,] 0.143 -0.510 [94,] -0.377 -0.289 [95,] 0.816 0.669 [96,] -0.360 -0.311 [97,] 1.312 2.597 [98,] 0.920 0.996 [99,] -0.141 -0.511 [100,] -0.616 0.145 > mlIndFixNm3 <- maxLik( llfInd, start = startValFix, fixed = "mu", + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlIndFixNm, mlIndFixNm3, tolerance = 1e-3 ) [1] TRUE > mlIndFixNm4 <- maxLik( llfInd, start = startValFix, fixed = 1, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlIndFixNm, mlIndFixNm4, tolerance = 1e-3 ) [1] TRUE > nObs( mlIndFixNm ) [1] 100 > > # with analytical gradients > mlgFixNm <- maxLik( llf, gf, start = startValFix, fixed = isFixed, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > mlgFixNm3 <- maxLik( llf, gf, start = startValFix, fixed = "mu", + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlgFixNm, mlgFixNm3, tolerance = 1e-3 ) [1] TRUE > mlgFixNm4 <- maxLik( llf, gf, start = startValFix, fixed = 1, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlgFixNm, mlgFixNm4, tolerance = 1e-3 ) [1] TRUE > print( summary( mlgFixNm ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 24 iterations Return code 0: successful convergence Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlFixNm, mlgFixNm, tolerance = 1e-3 ) [1] TRUE > mlgIndFixNm <- maxLik( llfInd, gfInd, start = startValFix, fixed = isFixed, + method = "NM") Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlgFixNm[ ], mlgIndFixNm[ -12 ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgIndFixNm[[ 12 ]], 3 ) mu sigma [1,] -0.336 -0.341 [2,] -0.138 -0.513 [3,] 0.935 1.049 [4,] 0.042 -0.544 [5,] 0.078 -0.537 [6,] 1.029 1.385 [7,] 0.277 -0.408 [8,] -0.759 0.504 [9,] -0.412 -0.238 [10,] -0.267 -0.417 [11,] 0.734 0.437 [12,] 0.216 -0.463 [13,] 0.240 -0.442 [14,] 0.066 -0.540 [15,] -0.333 -0.345 [16,] 1.072 1.551 [17,] 0.299 -0.385 [18,] -1.180 1.994 [19,] 0.421 -0.224 [20,] -0.284 -0.401 [21,] -0.641 0.202 [22,] -0.131 -0.516 [23,] -0.616 0.144 [24,] -0.437 -0.199 [25,] -0.375 -0.291 [26,] -1.012 1.322 [27,] 0.503 -0.086 [28,] 0.092 -0.532 [29,] -0.683 0.304 [30,] 0.752 0.485 [31,] 0.256 -0.428 [32,] -0.177 -0.490 [33,] 0.537 -0.021 [34,] 0.527 -0.041 [35,] 0.493 -0.104 [36,] 0.413 -0.236 [37,] 0.332 -0.346 [38,] -0.037 -0.545 [39,] -0.184 -0.486 [40,] -0.228 -0.453 [41,] -0.417 -0.231 [42,] -0.125 -0.519 [43,] -0.759 0.505 [44,] 1.301 2.544 [45,] 0.725 0.411 [46,] -0.674 0.281 [47,] -0.242 -0.441 [48,] -0.280 -0.405 [49,] 0.468 -0.148 [50,] -0.050 -0.543 [51,] 0.152 -0.506 [52,] -0.017 -0.547 [53,] -0.026 -0.547 [54,] 0.821 0.683 [55,] -0.135 -0.514 [56,] 0.910 0.964 [57,] -0.929 1.029 [58,] 0.351 -0.323 [59,] 0.074 -0.538 [60,] 0.130 -0.517 [61,] 0.228 -0.453 [62,] -0.301 -0.382 [63,] -0.200 -0.475 [64,] -0.611 0.134 [65,] -0.643 0.207 [66,] 0.182 -0.487 [67,] 0.269 -0.416 [68,] 0.032 -0.546 [69,] 0.553 0.011 [70,] 1.230 2.215 [71,] -0.295 -0.389 [72,] -1.385 2.957 [73,] 0.603 0.117 [74,] -0.426 -0.217 [75,] -0.413 -0.237 [76,] 0.615 0.144 [77,] -0.171 -0.494 [78,] -0.732 0.432 [79,] 0.109 -0.526 [80,] -0.083 -0.535 [81,] 0.003 -0.548 [82,] 0.231 -0.450 [83,] -0.222 -0.457 [84,] 0.387 -0.275 [85,] -0.132 -0.516 [86,] 0.199 -0.475 [87,] 0.658 0.243 [88,] 0.261 -0.423 [89,] -0.196 -0.478 [90,] 0.689 0.320 [91,] 0.596 0.101 [92,] 0.329 -0.350 [93,] 0.143 -0.510 [94,] -0.377 -0.289 [95,] 0.816 0.669 [96,] -0.360 -0.311 [97,] 1.312 2.597 [98,] 0.920 0.996 [99,] -0.141 -0.511 [100,] -0.616 0.145 > > # with unused Hessians > mlghFixNm <- maxLik( llf, gf, hf, start = startValFix, fixed = isFixed, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlgFixNm, mlghFixNm, tolerance = 1e-3 ) [1] TRUE > mlghFixNm3 <- maxLik( llf, gf, hf, start = startValFix, fixed = "mu", + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlghFixNm, mlghFixNm3, tolerance = 1e-3 ) [1] TRUE > mlghFixNm4 <- maxLik( llf, gf, hf, start = startValFix, fixed = 1, + method = "NM" ) Warning message: In optim(par = c(sigma = 1), fn = function (theta, fnOrig, gradOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlghFixNm, mlghFixNm4, tolerance = 1e-3 ) [1] TRUE > > ## SANN method with fixed parameters > mlFixSann <- maxLik( llf, start = startValFix, fixed = isFixed, + method = "SANN" ) > mlFixSann3 <- maxLik( llf, start = startValFix, fixed = "mu", + method = "SANN" ) > all.equal( mlFixSann, mlFixSann3, tolerance = 1e-3 ) [1] TRUE > mlFixSann4 <- maxLik( llf, start = startValFix, fixed = 1, + method = "SANN" ) > all.equal( mlFixSann, mlFixSann4, tolerance = 1e-3 ) [1] TRUE > print( mlFixSann ) Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -202.1 (1 free parameter(s)) Estimate(s): 1 1.825 > print( summary( mlFixSann ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > activePar( mlFixSann ) mu sigma FALSE TRUE > AIC( mlFixSann ) [1] 406.2 attr(,"df") [1] 1 > coef( mlFixSann ) mu sigma 1.000 1.825 > condiNumber( mlFixSann, digits = 3 ) sigma 1 > round( hessian( mlFixSann ), 1 ) mu sigma mu -30.0 -5.9 sigma -5.9 -60.0 > logLik( mlFixSann ) [1] -202.1 attr(,"df") [1] 1 > maximType( mlFixSann ) [1] "SANN maximization" > nIter( mlFixSann ) function 10000 > nParam( mlFixSann ) [1] 2 > returnCode( mlFixSann ) [1] 0 > returnMessage( mlFixSann ) [1] "successful convergence " > round( vcov( mlFixSann ), 3 ) mu sigma mu 0 0.000 sigma 0 0.017 > logLik( summary( mlFixSann ) ) [1] -202.1 attr(,"df") [1] 1 > all.equal( mlFixBfgs[ -c(4,9,10) ], mlFixSann[ -c(4,9,10) ], + tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 49 >" > mlIndFixSann <- maxLik( llfInd, start = startValFix, fixed = isFixed, + method = "SANN" ) > all.equal( mlFixSann[ ], mlIndFixSann[ -12 ], tolerance = 1e-2 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlIndFixSann[[ 12 ]], 3 ) mu sigma [1,] -0.336 -0.341 [2,] -0.138 -0.513 [3,] 0.936 1.050 [4,] 0.042 -0.545 [5,] 0.078 -0.537 [6,] 1.029 1.386 [7,] 0.277 -0.408 [8,] -0.759 0.505 [9,] -0.412 -0.238 [10,] -0.267 -0.417 [11,] 0.735 0.438 [12,] 0.216 -0.463 [13,] 0.241 -0.442 [14,] 0.066 -0.540 [15,] -0.334 -0.345 [16,] 1.073 1.552 [17,] 0.299 -0.385 [18,] -1.180 1.995 [19,] 0.421 -0.224 [20,] -0.284 -0.401 [21,] -0.641 0.202 [22,] -0.131 -0.517 [23,] -0.616 0.144 [24,] -0.437 -0.198 [25,] -0.375 -0.291 [26,] -1.012 1.323 [27,] 0.503 -0.086 [28,] 0.092 -0.532 [29,] -0.683 0.304 [30,] 0.753 0.486 [31,] 0.256 -0.428 [32,] -0.177 -0.491 [33,] 0.537 -0.021 [34,] 0.527 -0.041 [35,] 0.493 -0.104 [36,] 0.413 -0.236 [37,] 0.332 -0.346 [38,] -0.037 -0.545 [39,] -0.184 -0.486 [40,] -0.228 -0.453 [41,] -0.417 -0.230 [42,] -0.125 -0.519 [43,] -0.759 0.505 [44,] 1.302 2.546 [45,] 0.725 0.412 [46,] -0.674 0.282 [47,] -0.242 -0.441 [48,] -0.280 -0.405 [49,] 0.468 -0.148 [50,] -0.050 -0.543 [51,] 0.152 -0.506 [52,] -0.017 -0.547 [53,] -0.026 -0.547 [54,] 0.821 0.684 [55,] -0.136 -0.514 [56,] 0.910 0.964 [57,] -0.930 1.030 [58,] 0.351 -0.323 [59,] 0.074 -0.538 [60,] 0.130 -0.517 [61,] 0.228 -0.453 [62,] -0.301 -0.382 [63,] -0.200 -0.475 [64,] -0.611 0.134 [65,] -0.643 0.208 [66,] 0.182 -0.487 [67,] 0.269 -0.416 [68,] 0.032 -0.546 [69,] 0.554 0.012 [70,] 1.230 2.216 [71,] -0.295 -0.389 [72,] -1.386 2.959 [73,] 0.604 0.117 [74,] -0.426 -0.217 [75,] -0.413 -0.237 [76,] 0.616 0.144 [77,] -0.171 -0.494 [78,] -0.733 0.432 [79,] 0.109 -0.526 [80,] -0.083 -0.535 [81,] 0.003 -0.548 [82,] 0.231 -0.450 [83,] -0.222 -0.457 [84,] 0.387 -0.275 [85,] -0.132 -0.516 [86,] 0.199 -0.475 [87,] 0.658 0.243 [88,] 0.261 -0.423 [89,] -0.196 -0.478 [90,] 0.690 0.320 [91,] 0.596 0.101 [92,] 0.329 -0.350 [93,] 0.143 -0.510 [94,] -0.377 -0.289 [95,] 0.817 0.670 [96,] -0.360 -0.311 [97,] 1.313 2.598 [98,] 0.920 0.997 [99,] -0.141 -0.511 [100,] -0.616 0.145 > nObs( mlIndFixSann ) [1] 100 > > # with analytical gradients > mlgFixSann <- maxLik( llf, gf, start = startValFix, fixed = isFixed, + method = "SANN" ) > print( summary( mlgFixSann ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -202.1 1 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.00 0.00 NA NA sigma 1.83 0.13 14 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > all.equal( mlFixSann[-4], mlgFixSann[-4], tolerance = 1e-3 ) [1] TRUE > mlgIndFixSann <- maxLik( llfInd, gfInd, start = startValFix, fixed = isFixed, + method = "SANN") > all.equal( mlgFixSann[ ], mlgIndFixSann[ -12 ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgIndFixSann[[ 12 ]], 3 ) mu sigma [1,] -0.336 -0.341 [2,] -0.138 -0.513 [3,] 0.936 1.050 [4,] 0.042 -0.545 [5,] 0.078 -0.537 [6,] 1.029 1.386 [7,] 0.277 -0.408 [8,] -0.759 0.505 [9,] -0.412 -0.238 [10,] -0.267 -0.417 [11,] 0.735 0.438 [12,] 0.216 -0.463 [13,] 0.241 -0.442 [14,] 0.066 -0.540 [15,] -0.334 -0.345 [16,] 1.073 1.552 [17,] 0.299 -0.385 [18,] -1.180 1.995 [19,] 0.421 -0.224 [20,] -0.284 -0.401 [21,] -0.641 0.202 [22,] -0.131 -0.517 [23,] -0.616 0.144 [24,] -0.437 -0.198 [25,] -0.375 -0.291 [26,] -1.012 1.323 [27,] 0.503 -0.086 [28,] 0.092 -0.532 [29,] -0.683 0.304 [30,] 0.753 0.486 [31,] 0.256 -0.428 [32,] -0.177 -0.491 [33,] 0.537 -0.021 [34,] 0.527 -0.041 [35,] 0.493 -0.104 [36,] 0.413 -0.236 [37,] 0.332 -0.346 [38,] -0.037 -0.545 [39,] -0.184 -0.486 [40,] -0.228 -0.453 [41,] -0.417 -0.230 [42,] -0.125 -0.519 [43,] -0.759 0.505 [44,] 1.302 2.546 [45,] 0.725 0.412 [46,] -0.674 0.282 [47,] -0.242 -0.441 [48,] -0.280 -0.405 [49,] 0.468 -0.148 [50,] -0.050 -0.543 [51,] 0.152 -0.506 [52,] -0.017 -0.547 [53,] -0.026 -0.547 [54,] 0.821 0.684 [55,] -0.136 -0.514 [56,] 0.910 0.964 [57,] -0.930 1.030 [58,] 0.351 -0.323 [59,] 0.074 -0.538 [60,] 0.130 -0.517 [61,] 0.228 -0.453 [62,] -0.301 -0.382 [63,] -0.200 -0.475 [64,] -0.611 0.134 [65,] -0.643 0.208 [66,] 0.182 -0.487 [67,] 0.269 -0.416 [68,] 0.032 -0.546 [69,] 0.554 0.012 [70,] 1.230 2.216 [71,] -0.295 -0.389 [72,] -1.386 2.959 [73,] 0.604 0.117 [74,] -0.426 -0.217 [75,] -0.413 -0.237 [76,] 0.616 0.144 [77,] -0.171 -0.494 [78,] -0.733 0.432 [79,] 0.109 -0.526 [80,] -0.083 -0.535 [81,] 0.003 -0.548 [82,] 0.231 -0.450 [83,] -0.222 -0.457 [84,] 0.387 -0.275 [85,] -0.132 -0.516 [86,] 0.199 -0.475 [87,] 0.658 0.243 [88,] 0.261 -0.423 [89,] -0.196 -0.478 [90,] 0.690 0.320 [91,] 0.596 0.101 [92,] 0.329 -0.350 [93,] 0.143 -0.510 [94,] -0.377 -0.289 [95,] 0.817 0.670 [96,] -0.360 -0.311 [97,] 1.313 2.598 [98,] 0.920 0.997 [99,] -0.141 -0.511 [100,] -0.616 0.145 > > # with unused Hessians > mlghFixSann <- maxLik( llf, gf, hf, start = startValFix, fixed = isFixed, + method = "SANN" ) > all.equal( mlgFixSann, mlghFixSann, tolerance = 1e-3 ) [1] TRUE > > > ############### inequality constraints ############### > A <- matrix( -1, nrow = 1, ncol = 2 ) > inEq <- list( ineqA = A, ineqB = 2.5 ) > > ## BFGS method with inequality constraints > mlBfgsInEq <- maxLik( llf, start = startVal, constraints = inEq, + method = "BFGS" ) > print( mlBfgsInEq ) Maximum Likelihood estimation BFGS maximization, 130 iterations Return code 0: successful convergence Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.8197 1.68 > print( summary( mlBfgsInEq ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 130 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.00145 -------------------------------------------- > activePar( mlBfgsInEq ) mu sigma TRUE TRUE > AIC( mlBfgsInEq ) [1] 413.1 attr(,"df") [1] 2 > coef( mlBfgsInEq ) mu sigma 0.8197 1.6803 > condiNumber( mlBfgsInEq, digits = 3 ) mu 1 sigma 3.61 > round( hessian( mlBfgsInEq ), 1 ) mu sigma mu -35.4 -15.2 sigma -15.2 -93.7 > logLik( mlBfgsInEq ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlBfgsInEq ) [1] "BFGS maximization" > nIter( mlBfgsInEq ) function 130 > nParam( mlBfgsInEq ) [1] 2 > returnCode( mlBfgsInEq ) [1] 0 > returnMessage( mlBfgsInEq ) [1] "successful convergence " > round( vcov( mlBfgsInEq ), 3 ) mu sigma mu 0.030 -0.005 sigma -0.005 0.011 > logLik( summary( mlBfgsInEq ) ) [1] -204.5 attr(,"df") [1] 2 > mlBfgsInEqInd <- maxLik( llfInd, start = startVal, constraints = inEq, + method = "BFGS" ) > print( summary( mlBfgsInEqInd ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 130 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.00145 -------------------------------------------- > all.equal( mlBfgsInEq[ ], mlBfgsInEqInd[ -12 ], tolerance = 1e-3 ) [1] "Component \"hessian\": Mean relative difference: 0.001866" [2] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlBfgsInEqInd[[ 12 ]], 3 ) mu sigma [1,] -0.333 -0.409 [2,] -0.099 -0.579 [3,] 1.168 1.697 [4,] 0.114 -0.573 [5,] 0.155 -0.555 [6,] 1.279 2.153 [7,] 0.390 -0.339 [8,] -0.832 0.569 [9,] -0.423 -0.295 [10,] -0.252 -0.489 [11,] 0.931 0.861 [12,] 0.319 -0.424 [13,] 0.348 -0.392 [14,] 0.142 -0.561 [15,] -0.330 -0.412 [16,] 1.330 2.376 [17,] 0.417 -0.304 [18,] -1.329 2.374 [19,] 0.561 -0.067 [20,] -0.271 -0.472 [21,] -0.693 0.211 [22,] -0.091 -0.581 [23,] -0.663 0.143 [24,] -0.452 -0.251 [25,] -0.379 -0.354 [26,] -1.131 1.554 [27,] 0.657 0.131 [28,] 0.173 -0.545 [29,] -0.742 0.331 [30,] 0.952 0.928 [31,] 0.366 -0.370 [32,] -0.145 -0.560 [33,] 0.698 0.223 [34,] 0.686 0.195 [35,] 0.646 0.106 [36,] 0.552 -0.084 [37,] 0.456 -0.245 [38,] 0.020 -0.594 [39,] -0.153 -0.556 [40,] -0.206 -0.524 [41,] -0.428 -0.287 [42,] -0.083 -0.583 [43,] -0.833 0.569 [44,] 1.600 3.708 [45,] 0.920 0.826 [46,] -0.732 0.305 [47,] -0.222 -0.513 [48,] -0.267 -0.476 [49,] 0.616 0.043 [50,] 0.005 -0.595 [51,] 0.243 -0.496 [52,] 0.044 -0.592 [53,] 0.033 -0.593 [54,] 1.033 1.199 [55,] -0.096 -0.580 [56,] 1.138 1.581 [57,] -1.033 1.199 [58,] 0.478 -0.211 [59,] 0.152 -0.557 [60,] 0.217 -0.516 [61,] 0.333 -0.409 [62,] -0.292 -0.452 [63,] -0.172 -0.545 [64,] -0.658 0.132 [65,] -0.695 0.217 [66,] 0.279 -0.464 [67,] 0.381 -0.351 [68,] 0.101 -0.578 [69,] 0.717 0.269 [70,] 1.516 3.267 [71,] -0.284 -0.460 [72,] -1.572 3.557 [73,] 0.776 0.417 [74,] -0.439 -0.272 [75,] -0.424 -0.294 [76,] 0.790 0.454 [77,] -0.138 -0.563 [78,] -0.801 0.483 [79,] 0.192 -0.533 [80,] -0.035 -0.593 [81,] 0.068 -0.587 [82,] 0.337 -0.405 [83,] -0.199 -0.529 [84,] 0.520 -0.140 [85,] -0.092 -0.581 [86,] 0.299 -0.445 [87,] 0.841 0.593 [88,] 0.372 -0.362 [89,] -0.167 -0.548 [90,] 0.878 0.699 [91,] 0.768 0.395 [92,] 0.452 -0.251 [93,] 0.233 -0.504 [94,] -0.381 -0.351 [95,] 1.028 1.180 [96,] -0.361 -0.376 [97,] 1.613 3.778 [98,] 1.150 1.625 [99,] -0.103 -0.577 [100,] -0.663 0.144 > nObs( mlBfgsInEqInd ) [1] 100 > > # with analytical gradients > mlgBfgsInEq <- maxLik( llf, gf, start = startVal, constraints = inEq, + method = "BFGS" ) > all.equal( mlBfgsInEq, mlgBfgsInEq, tolerance = 1e-3 ) [1] TRUE > mlgBfgsInEqInd <- maxLik( llfInd, gfInd, start = startVal, constraints = inEq, + method = "BFGS" ) > all.equal( mlgBfgsInEqInd[ -12 ], mlgBfgsInEq[ ], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlgBfgsInEqInd[[ 12 ]], 3 ) mu sigma [1,] -0.333 -0.409 [2,] -0.099 -0.579 [3,] 1.168 1.697 [4,] 0.114 -0.573 [5,] 0.155 -0.555 [6,] 1.279 2.153 [7,] 0.390 -0.339 [8,] -0.832 0.569 [9,] -0.423 -0.295 [10,] -0.252 -0.489 [11,] 0.931 0.861 [12,] 0.319 -0.424 [13,] 0.348 -0.392 [14,] 0.142 -0.561 [15,] -0.330 -0.412 [16,] 1.330 2.376 [17,] 0.417 -0.304 [18,] -1.329 2.374 [19,] 0.561 -0.067 [20,] -0.271 -0.472 [21,] -0.693 0.211 [22,] -0.091 -0.581 [23,] -0.663 0.143 [24,] -0.452 -0.251 [25,] -0.379 -0.354 [26,] -1.131 1.554 [27,] 0.657 0.131 [28,] 0.173 -0.545 [29,] -0.742 0.331 [30,] 0.952 0.928 [31,] 0.366 -0.370 [32,] -0.145 -0.560 [33,] 0.698 0.223 [34,] 0.686 0.195 [35,] 0.646 0.106 [36,] 0.552 -0.084 [37,] 0.456 -0.245 [38,] 0.020 -0.594 [39,] -0.153 -0.556 [40,] -0.206 -0.524 [41,] -0.428 -0.287 [42,] -0.083 -0.583 [43,] -0.833 0.569 [44,] 1.600 3.708 [45,] 0.920 0.826 [46,] -0.732 0.305 [47,] -0.222 -0.513 [48,] -0.267 -0.476 [49,] 0.616 0.043 [50,] 0.005 -0.595 [51,] 0.243 -0.496 [52,] 0.044 -0.592 [53,] 0.033 -0.593 [54,] 1.033 1.199 [55,] -0.096 -0.580 [56,] 1.138 1.581 [57,] -1.033 1.199 [58,] 0.478 -0.211 [59,] 0.152 -0.557 [60,] 0.217 -0.516 [61,] 0.333 -0.409 [62,] -0.292 -0.452 [63,] -0.172 -0.545 [64,] -0.658 0.132 [65,] -0.695 0.217 [66,] 0.279 -0.464 [67,] 0.381 -0.351 [68,] 0.101 -0.578 [69,] 0.717 0.269 [70,] 1.516 3.267 [71,] -0.284 -0.460 [72,] -1.572 3.557 [73,] 0.776 0.417 [74,] -0.439 -0.272 [75,] -0.424 -0.294 [76,] 0.790 0.454 [77,] -0.138 -0.563 [78,] -0.801 0.483 [79,] 0.192 -0.533 [80,] -0.035 -0.593 [81,] 0.068 -0.587 [82,] 0.337 -0.405 [83,] -0.199 -0.529 [84,] 0.520 -0.140 [85,] -0.092 -0.581 [86,] 0.299 -0.445 [87,] 0.841 0.593 [88,] 0.372 -0.362 [89,] -0.167 -0.548 [90,] 0.878 0.699 [91,] 0.768 0.395 [92,] 0.452 -0.251 [93,] 0.233 -0.504 [94,] -0.381 -0.351 [95,] 1.028 1.180 [96,] -0.361 -0.376 [97,] 1.613 3.778 [98,] 1.150 1.625 [99,] -0.103 -0.577 [100,] -0.663 0.144 > mlgBfgsInEqInd2 <- maxLik( llf, gfInd, start = startVal, constraints = inEq, + method = "BFGS" ) > all.equal( mlgBfgsInEqInd, mlgBfgsInEqInd2, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with unused Hessian > mlghBfgsInEq <- maxLik( llf, gf, hf, start = startVal, constraints = inEq, + method = "BFGS" ) > all.equal( mlgBfgsInEq, mlghBfgsInEq, tolerance = 1e-3 ) [1] TRUE > > ## NM method with inequality constraints > mlNmInEq <- maxLik( llf, start = startVal, constraints = inEq, method = "NM" ) > print( mlNmInEq ) Maximum Likelihood estimation Nelder-Mead maximization, 101 iterations Return code 0: successful convergence Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.8197 1.68 > print( summary( mlNmInEq ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 101 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.001468 -------------------------------------------- > activePar( mlNmInEq ) mu sigma TRUE TRUE > AIC( mlNmInEq ) [1] 413.1 attr(,"df") [1] 2 > coef( mlNmInEq ) mu sigma 0.8197 1.6803 > condiNumber( mlNmInEq, digits = 3 ) mu 1 sigma 3.61 > round( hessian( mlNmInEq ), 1 ) mu sigma mu -35.4 -15.2 sigma -15.2 -93.6 > logLik( mlNmInEq ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlNmInEq ) [1] "Nelder-Mead maximization" > nIter( mlNmInEq ) function 101 > nParam( mlNmInEq ) [1] 2 > returnCode( mlNmInEq ) [1] 0 > returnMessage( mlNmInEq ) [1] "successful convergence " > round( vcov( mlNmInEq ), 3 ) mu sigma mu 0.030 -0.005 sigma -0.005 0.011 > logLik( summary( mlNmInEq ) ) [1] -204.5 attr(,"df") [1] 2 > all.equal( mlBfgsInEq[-c(9,10,11)], mlNmInEq[-c(9,10,11)], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 1.5 >" > mlNmInEqInd <- maxLik( llfInd, start = startVal, constraints = inEq, + method = "NM" ) > print( summary( mlNmInEqInd ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 101 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.001468 -------------------------------------------- > all.equal( mlNmInEq[-4], mlNmInEqInd[-c(4,12)], tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > round( mlNmInEqInd[[ 12 ]], 3 ) mu sigma [1,] -0.333 -0.409 [2,] -0.099 -0.579 [3,] 1.168 1.697 [4,] 0.114 -0.573 [5,] 0.155 -0.555 [6,] 1.279 2.153 [7,] 0.390 -0.339 [8,] -0.832 0.569 [9,] -0.423 -0.295 [10,] -0.252 -0.489 [11,] 0.931 0.861 [12,] 0.319 -0.424 [13,] 0.348 -0.392 [14,] 0.142 -0.561 [15,] -0.330 -0.412 [16,] 1.330 2.376 [17,] 0.417 -0.304 [18,] -1.329 2.374 [19,] 0.561 -0.067 [20,] -0.271 -0.472 [21,] -0.693 0.211 [22,] -0.091 -0.581 [23,] -0.663 0.143 [24,] -0.452 -0.251 [25,] -0.379 -0.354 [26,] -1.131 1.554 [27,] 0.657 0.131 [28,] 0.173 -0.545 [29,] -0.742 0.331 [30,] 0.952 0.928 [31,] 0.366 -0.370 [32,] -0.145 -0.560 [33,] 0.698 0.223 [34,] 0.686 0.195 [35,] 0.646 0.106 [36,] 0.552 -0.084 [37,] 0.456 -0.245 [38,] 0.020 -0.594 [39,] -0.153 -0.556 [40,] -0.206 -0.524 [41,] -0.428 -0.287 [42,] -0.083 -0.583 [43,] -0.833 0.569 [44,] 1.600 3.708 [45,] 0.920 0.826 [46,] -0.732 0.305 [47,] -0.222 -0.513 [48,] -0.267 -0.476 [49,] 0.616 0.043 [50,] 0.005 -0.595 [51,] 0.243 -0.496 [52,] 0.044 -0.592 [53,] 0.033 -0.593 [54,] 1.033 1.199 [55,] -0.096 -0.580 [56,] 1.138 1.581 [57,] -1.033 1.199 [58,] 0.478 -0.211 [59,] 0.152 -0.557 [60,] 0.217 -0.516 [61,] 0.333 -0.409 [62,] -0.292 -0.452 [63,] -0.172 -0.545 [64,] -0.658 0.132 [65,] -0.695 0.217 [66,] 0.279 -0.464 [67,] 0.381 -0.351 [68,] 0.101 -0.578 [69,] 0.717 0.269 [70,] 1.516 3.267 [71,] -0.284 -0.460 [72,] -1.572 3.557 [73,] 0.776 0.417 [74,] -0.439 -0.272 [75,] -0.424 -0.294 [76,] 0.790 0.454 [77,] -0.138 -0.563 [78,] -0.801 0.483 [79,] 0.192 -0.533 [80,] -0.035 -0.593 [81,] 0.068 -0.587 [82,] 0.337 -0.405 [83,] -0.199 -0.529 [84,] 0.520 -0.140 [85,] -0.092 -0.581 [86,] 0.299 -0.445 [87,] 0.841 0.593 [88,] 0.372 -0.362 [89,] -0.167 -0.548 [90,] 0.878 0.699 [91,] 0.768 0.395 [92,] 0.452 -0.251 [93,] 0.233 -0.504 [94,] -0.381 -0.351 [95,] 1.028 1.180 [96,] -0.361 -0.376 [97,] 1.613 3.778 [98,] 1.150 1.625 [99,] -0.103 -0.577 [100,] -0.663 0.144 > nObs( mlNmInEqInd ) [1] 100 > > # with unused analytical gradients > mlgNmInEq <- maxLik( llf, gf, start = startVal, constraints = inEq, + method = "NM" ) > all.equal( mlNmInEq, mlgNmInEq, tolerance = 1e-3 ) [1] TRUE > > # with unused analytical gradients and Hessians > mlghNmInEq <- maxLik( llf, gf, hf, start = startVal, constraints = inEq, + method = "NM" ) > all.equal( mlgNmInEq, mlghNmInEq, tolerance = 1e-3 ) [1] TRUE > > ## SANN method with inequality constraints > mlSannInEq <- maxLik( llf, start = startVal, constraints = inEq, + method = "SANN" ) > print( mlSannInEq ) Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.8297 1.67 > print( summary( mlSannInEq ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.83 0.17 4.8 2e-06 *** sigma 1.67 0.11 15.8 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.001043 -------------------------------------------- > activePar( mlSannInEq ) mu sigma TRUE TRUE > AIC( mlSannInEq ) [1] 413.1 attr(,"df") [1] 2 > coef( mlSannInEq ) mu sigma 0.8297 1.6702 > condiNumber( mlSannInEq, digits = 3 ) mu 1 sigma 3.6 > round( hessian( mlSannInEq ), 1 ) mu sigma mu -35.9 -15.1 sigma -15.1 -96.1 > logLik( mlSannInEq ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlSannInEq ) [1] "SANN maximization" > nIter( mlSannInEq ) function 10000 > nParam( mlSannInEq ) [1] 2 > returnCode( mlSannInEq ) [1] 0 > returnMessage( mlSannInEq ) [1] "successful convergence " > round( vcov( mlSannInEq ), 3 ) mu sigma mu 0.030 -0.005 sigma -0.005 0.011 > logLik( summary( mlSannInEq ) ) [1] -204.5 attr(,"df") [1] 2 > all.equal( mlBfgsInEq[-c(2,3,4,9,10,11)], mlSannInEq[-c(2,3,4,9,10,11)], + tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 49 >" > all.equal( mlBfgsInEq[-c(3,4,9,10,11)], mlSannInEq[-c(3,4,9,10,11)], + tolerance = 1e-2 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 49 >" > # with unused analytical gradients > mlgSannInEq <- maxLik( llf, gf, start = startVal, constraints = inEq, + method = "SANN" ) > all.equal( mlSannInEq, mlgSannInEq, tolerance = 1e-3 ) [1] TRUE > > # with a user-specified function to generate a new candidate point > mlSannInEqCand <- maxLik( llf, start = startVal, constraints = inEq, + method = "SANN", cand = function(x)c(rnorm(1,x[1]),rnorm(1,x[2])) ) > print( summary( mlSannInEqCand ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -204.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.81 0.17 4.6 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.0005163 -------------------------------------------- > all.equal( mlSannInEqCand[-c(2,3,4)], mlSannInEq[-c(2,3,4)], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"sann_cand\": Modes of target, current: function, name >" [2] "Component \"control\": Attributes: < Component \"sann_cand\": target, current do not match when deparsed >" > all.equal( mlSannInEqCand, mlSannInEq, tolerance = 1e-1 ) [1] "Component \"control\": Attributes: < Component \"sann_cand\": Modes of target, current: function, name >" [2] "Component \"control\": Attributes: < Component \"sann_cand\": target, current do not match when deparsed >" > > ############### equality constraints ############### > eqCon <- list( eqA = A, eqB = 2.5 ) > > # with analytical gradients as attribute > mlGCon <- maxLik( llfGrad, start = startVal, constraints = eqCon ) > > # with analytical gradients and Hessians > mlghCon <- maxLik( llf, gf, hf, start = startVal, constraints = eqCon ) > all.equal( mlGCon, mlghCon, tolerance = 1e-3 ) [1] "Component \"last.step\": Component \"f0\": Attributes: < Component \"hessian\": Attributes: < Length mismatch: comparison on first 1 components > >" [2] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients and Hessians as attributes > mlGHCon <- maxLik( llfGradHess, start = startVal, constraints = eqCon ) > all.equal( mlGHCon, mlghCon, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlGHCon[-c(2,3,4,5,6,7,9,11)], mlGCon[-c(2,3,4,5,6,7,9,11)], + tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlGHCon[-c(5,6,7,9,11)], mlGCon[-c(5,6,7,9,11)], + tolerance = 1e-1 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > > ## BHHH method with equality constraints > mlBhhhCon <- maxLik( llfInd, start = startVal, constraints = eqCon, + method = "BHHH" ) > print( mlBhhhCon ) Maximum Likelihood estimation BHHH maximisation, 4 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.8204 1.68 > print( summary( mlBhhhCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 4 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 2e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 10 outer iterations, barrier value 2.414e-10 -------------------------------------------- > activePar( mlBhhhCon ) mu sigma TRUE TRUE > AIC( mlBhhhCon ) [1] 413.1 attr(,"df") [1] 2 > coef( mlBhhhCon ) mu sigma 0.8204 1.6797 > condiNumber( mlBhhhCon, digits = 3 ) mu 1 sigma 3.61 > round( hessian( mlBhhhCon ), 1 ) mu sigma mu -35.5 -15.2 sigma -15.2 -93.8 > logLik( mlBhhhCon ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlBhhhCon ) [1] "BHHH maximisation" > nIter( mlBhhhCon ) [1] 4 > nParam( mlBhhhCon ) [1] 2 > returnCode( mlBhhhCon ) [1] 2 > returnMessage( mlBhhhCon ) [1] "successive function values within tolerance limit" > round( vcov( mlBhhhCon ), 3 ) mu sigma mu 0.030 -0.005 sigma -0.005 0.011 > logLik( summary( mlBhhhCon ) ) [1] -204.5 attr(,"df") [1] 2 > all.equal( mlGCon[ -c( 5, 6, 7, 9, 10 ) ], mlBhhhCon[ -c( 5, 6, 7, 9, 10, 11 ) ], + tolerance = 5e-3 ) [1] "Component \"estimate\": Mean relative difference: 0.01242" [2] "Component \"gradient\": Mean relative difference: 0.04815" [3] "Component \"hessian\": Mean relative difference: 0.02354" [4] "Component \"objectiveFn\": target, current do not match when deparsed" [5] "Component \"constraints\": Component \"code\": Mean relative difference: 0.5" [6] "Component \"constraints\": Component \"message\": 1 string mismatch" [7] "Component \"constraints\": Component \"outer.iterations\": Mean relative difference: 0.4286" > mlBhhhCon[11] $gradientObs mu sigma [1,] -0.333645 -0.40838 [2,] -0.099497 -0.57873 [3,] 1.168645 1.69861 [4,] 0.113660 -0.57366 [5,] 0.155329 -0.55483 [6,] 1.279487 2.15440 [7,] 0.390420 -0.33933 [8,] -0.833126 0.57050 [9,] -0.423234 -0.29448 [10,] -0.252254 -0.48848 [11,] 0.931429 0.86185 [12,] 0.318749 -0.42470 [13,] 0.347783 -0.39220 [14,] 0.142139 -0.56142 [15,] -0.330360 -0.41204 [16,] 1.330420 2.37768 [17,] 0.416603 -0.30384 [18,] -1.330459 2.37785 [19,] 0.560868 -0.06698 [20,] -0.271486 -0.47156 [21,] -0.693304 0.21201 [22,] -0.090846 -0.58149 [23,] -0.663659 0.14444 [24,] -0.453035 -0.25062 [25,] -0.379414 -0.35356 [26,] -1.132021 1.55709 [27,] 0.657584 0.13096 [28,] 0.172403 -0.54543 [29,] -0.743149 0.33227 [30,] 0.952506 0.92855 [31,] 0.365997 -0.37036 [32,] -0.145500 -0.55980 [33,] 0.698231 0.22352 [34,] 0.686186 0.19551 [35,] 0.646096 0.10580 [36,] 0.551854 -0.08383 [37,] 0.456349 -0.24556 [38,] 0.019787 -0.59470 [39,] -0.153221 -0.55592 [40,] -0.206040 -0.52405 [41,] -0.428802 -0.28652 [42,] -0.083716 -0.58359 [43,] -0.833364 0.57116 [44,] 1.601250 3.71130 [45,] 0.920001 0.82631 [46,] -0.732496 0.30587 [47,] -0.221929 -0.51263 [48,] -0.267136 -0.47549 [49,] 0.616594 0.04323 [50,] 0.004576 -0.59532 [51,] 0.243254 -0.49597 [52,] 0.043440 -0.59219 [53,] 0.033285 -0.59350 [54,] 1.033879 1.20005 [55,] -0.096373 -0.57976 [56,] 1.138703 1.58257 [57,] -1.034235 1.20128 [58,] 0.478109 -0.21141 [59,] 0.151477 -0.55682 [60,] 0.216757 -0.51644 [61,] 0.332803 -0.40932 [62,] -0.292421 -0.45173 [63,] -0.172535 -0.54536 [64,] -0.658392 0.13274 [65,] -0.696117 0.21857 [66,] 0.278848 -0.46475 [67,] 0.381412 -0.35101 [68,] 0.101251 -0.57814 [69,] 0.717472 0.26928 [70,] 1.516982 3.26994 [71,] -0.284416 -0.45949 [72,] -1.573295 3.56224 [73,] 0.776645 0.41778 [74,] -0.439076 -0.27154 [75,] -0.424053 -0.29332 [76,] 0.790704 0.45479 [77,] -0.138199 -0.56328 [78,] -0.801691 0.48418 [79,] 0.192202 -0.53331 [80,] -0.034784 -0.59332 [81,] 0.067763 -0.58764 [82,] 0.336802 -0.40482 [83,] -0.199085 -0.52878 [84,] 0.520475 -0.14035 [85,] -0.092627 -0.58095 [86,] 0.298877 -0.44532 [87,] 0.841226 0.59328 [88,] 0.372177 -0.36270 [89,] -0.167377 -0.54830 [90,] 0.878067 0.69967 [91,] 0.767972 0.39528 [92,] 0.452435 -0.25153 [93,] 0.232913 -0.50424 [94,] -0.381447 -0.35096 [95,] 1.028244 1.18053 [96,] -0.361848 -0.37543 [97,] 1.614278 3.78167 [98,] 1.150145 1.62656 [99,] -0.103412 -0.57739 [100,] -0.663954 0.14510 > nObs( mlBhhhCon ) [1] 100 > > # with analytical gradients > mlgBhhhCon <- maxLik( llf, gfInd, start = startVal, constraints = eqCon, + method = "BHHH" ) > print( summary( mlgBhhhCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 7 iterations Return code 3: Last step could not find a value above the current. Boundary of parameter space? Consider switching to a more robust optimisation method temporarily. Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.83 0.17 4.8 1e-06 *** sigma 1.67 0.10 15.9 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 9 outer iterations, barrier value 1.177e-08 -------------------------------------------- > all.equal( mlBhhhCon[-c(2,3,4,5,6,7,9,11,12)], mlgBhhhCon[-c(2,3,4,5,6,7,9,11,12)], + tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" [2] "Component \"constraints\": Component \"outer.iterations\": Mean relative difference: 0.1" > all.equal( mlBhhhCon[-c(5,6,7,9,12)], mlgBhhhCon[-c(5,6,7,9,12)], + tolerance = 1e-1 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > mlgBhhhConInd <- maxLik( llfInd, gfInd, start = startVal, constraints = eqCon, + method = "BHHH" ) > all.equal( mlgBhhhCon, mlgBhhhConInd, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > # with analytical gradients as attribute > mlGBhhhCon <- maxLik( llfGradInd, start = startVal, constraints = eqCon, + method = "BHHH" ) > print( summary( mlGBhhhCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 7 iterations Return code 3: Last step could not find a value above the current. Boundary of parameter space? Consider switching to a more robust optimisation method temporarily. Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.83 0.17 4.8 1e-06 *** sigma 1.67 0.10 15.9 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 9 outer iterations, barrier value 1.177e-08 -------------------------------------------- > all.equal( mlGBhhhCon, mlgBhhhCon, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlGBhhhCon[-c(2,3,4,5,6,7,9,11,12)], mlBhhhCon[-c(2,3,4,5,6,7,9,11,12)], + tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" [2] "Component \"constraints\": Component \"outer.iterations\": Mean relative difference: 0.1111" > all.equal( mlGBhhhCon[-c(5,6,7,9,12)], mlBhhhCon[-c(5,6,7,9,12)], + tolerance = 1e-1 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" [2] "Component \"constraints\": Component \"outer.iterations\": Mean relative difference: 0.1111" > > # with analytical gradients and unused Hessians > mlghBhhhCon <- maxLik( llf, gfInd, hf, start = startVal, constraints = eqCon, + method = "BHHH" ) > all.equal( mlgBhhhCon, mlghBhhhCon, tolerance = 1e-3 ) [1] TRUE > > # with analytical gradients and unused Hessians as attributes > mlGHBhhhCon <- maxLik( llfGradHessInd, start = startVal, constraints = eqCon, + method = "BHHH" ) > all.equal( mlGHBhhhCon, mlghBhhhCon, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > all.equal( mlGHBhhhCon, mlGBhhhCon, tolerance = 1e-3 ) [1] "Component \"objectiveFn\": target, current do not match when deparsed" > > > ## BFGS method with equality constraints > mlBfgsCon <- maxLik( llf, start = startVal, constraints = eqCon, + method = "BFGS" ) > print( mlBfgsCon ) Maximum Likelihood estimation BFGS maximization, 32 iterations Return code 0: successful convergence Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.8198 1.68 > print( summary( mlBfgsCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 32 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 10 outer iterations, barrier value 2.07e-10 -------------------------------------------- > activePar( mlBfgsCon ) mu sigma TRUE TRUE > AIC( mlBfgsCon ) [1] 413.1 attr(,"df") [1] 2 > coef( mlBfgsCon ) mu sigma 0.8198 1.6803 > condiNumber( mlBfgsCon, digits = 3 ) mu 1 sigma 3.61 > round( hessian( mlBfgsCon ), 1 ) mu sigma mu -35.4 -15.2 sigma -15.2 -93.7 > logLik( mlBfgsCon ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlBfgsCon ) [1] "BFGS maximization" > nIter( mlBfgsCon ) function 32 > nParam( mlBfgsCon ) [1] 2 > returnCode( mlBfgsCon ) [1] 0 > returnMessage( mlBfgsCon ) [1] "successful convergence " > round( vcov( mlBfgsCon ), 3 ) mu sigma mu 0.030 -0.005 sigma -0.005 0.011 > logLik( summary( mlBfgsCon ) ) [1] -204.5 attr(,"df") [1] 2 > all.equal( mlBfgsCon[ -c( 4, 5, 6, 9, 10 ) ], mlGCon[ -c( 4, 5, 6, 9, 10 ) ], + tolerance = 1e-3 ) [1] "Names: 3 string mismatches" [2] "Component \"estimate\": Mean relative difference: 0.01296" [3] "Component \"gradient\": Mean relative difference: 0.05056" [4] "Component \"last.step\": target is NULL, current is list" [5] "Component 6: Modes: list, S4" [6] "Component 6: Lengths: 5, 1" [7] "Component 6: names for target but not for current" [8] "Component 6: Attributes: < names for current but not for target >" [9] "Component 6: Attributes: < Length mismatch: comparison on first 0 components >" [10] "Component 6: current is not list-like" [11] "Component 7: Modes: S4, function" [12] "Component 7: Attributes: < Modes: list, NULL >" [13] "Component 7: Attributes: < Lengths: 20, 0 >" [14] "Component 7: Attributes: < names for target but not for current >" [15] "Component 7: Attributes: < current is not list-like >" [16] "Component 8: Modes of target, current: function, list" [17] "Component 8: target, current do not match when deparsed" > mlBfgsConInd <- maxLik( llfInd, start = startVal, constraints = eqCon, + method = "BFGS" ) > print( summary( mlBfgsConInd ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 31 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 10 outer iterations, barrier value 2.07e-10 -------------------------------------------- > all.equal( mlBfgsCon[-c(4,9)], mlBfgsConInd[-c(4,9,12)], tolerance = 1e-3 ) [1] TRUE > mlBfgsConInd[12] $gradientObs mu sigma [1,] -0.333193 -0.40861 [2,] -0.099212 -0.57861 [3,] 1.168023 1.69720 [4,] 0.113792 -0.57339 [5,] 0.155431 -0.55455 [6,] 1.278785 2.15258 [7,] 0.390354 -0.33911 [8,] -0.832318 0.56886 [9,] -0.422718 -0.29490 [10,] -0.251860 -0.48856 [11,] 0.930976 0.86117 [12,] 0.318734 -0.42444 [13,] 0.347748 -0.39195 [14,] 0.142251 -0.56114 [15,] -0.329910 -0.41226 [16,] 1.329682 2.37565 [17,] 0.416518 -0.30364 [18,] -1.329295 2.37393 [19,] 0.560680 -0.06693 [20,] -0.271079 -0.47167 [21,] -0.692596 0.21086 [22,] -0.090568 -0.58136 [23,] -0.662971 0.14338 [24,] -0.452498 -0.25110 [25,] -0.378930 -0.35388 [26,] -1.130999 1.55418 [27,] 0.657327 0.13086 [28,] 0.172493 -0.54515 [29,] -0.742405 0.33096 [30,] 0.952039 0.92781 [31,] 0.365949 -0.37013 [32,] -0.145183 -0.55973 [33,] 0.697945 0.22336 [34,] 0.685908 0.19537 [35,] 0.645847 0.10572 [36,] 0.551672 -0.08377 [37,] 0.456236 -0.24540 [38,] 0.019986 -0.59447 [39,] -0.152898 -0.55586 [40,] -0.205679 -0.52406 [41,] -0.428282 -0.28694 [42,] -0.083443 -0.58345 [43,] -0.832555 0.56953 [44,] 1.600319 3.70805 [45,] 0.919557 0.82566 [46,] -0.731759 0.30459 [47,] -0.221557 -0.51266 [48,] -0.266732 -0.47560 [49,] 0.616366 0.04320 [50,] 0.004786 -0.59511 [51,] 0.243293 -0.49569 [52,] 0.043622 -0.59195 [53,] 0.033475 -0.59326 [54,] 1.033353 1.19907 [55,] -0.096091 -0.57963 [56,] 1.138102 1.58126 [57,] -1.033283 1.19883 [58,] 0.477981 -0.21126 [59,] 0.151582 -0.55654 [60,] 0.216816 -0.51616 [61,] 0.332778 -0.40907 [62,] -0.291999 -0.45188 [63,] -0.172198 -0.54532 [64,] -0.657709 0.13171 [65,] -0.695406 0.21741 [66,] 0.278862 -0.46448 [67,] 0.381353 -0.35078 [68,] 0.101392 -0.57787 [69,] 0.717173 0.26908 [70,] 1.516111 3.26710 [71,] -0.283999 -0.45962 [72,] -1.571957 3.55687 [73,] 0.776303 0.41746 [74,] -0.438549 -0.27199 [75,] -0.423537 -0.29373 [76,] 0.790352 0.45444 [77,] -0.137887 -0.56320 [78,] -0.800905 0.48266 [79,] 0.192278 -0.53302 [80,] -0.034546 -0.59314 [81,] 0.067927 -0.58739 [82,] 0.336774 -0.40457 [83,] -0.198729 -0.52879 [84,] 0.520316 -0.14025 [85,] -0.092347 -0.58082 [86,] 0.298876 -0.44505 [87,] 0.840838 0.59282 [88,] 0.372124 -0.36247 [89,] -0.167044 -0.54826 [90,] 0.877652 0.69912 [91,] 0.767636 0.39498 [92,] 0.452325 -0.25137 [93,] 0.232960 -0.50396 [94,] -0.380961 -0.35129 [95,] 1.027722 1.17957 [96,] -0.361376 -0.37571 [97,] 1.613337 3.77834 [98,] 1.149536 1.62521 [99,] -0.103125 -0.57728 [100,] -0.663266 0.14404 > nObs( mlBfgsConInd ) [1] 100 > > # with analytical gradients > mlgBfgsCon <- maxLik( llf, gf, start = startVal, constraints = eqCon, + method = "BFGS" ) > print( summary( mlgBfgsCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 30 iterations Return code 0: successful convergence Log-Likelihood: -204.9 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.81 0.17 4.7 3e-06 *** sigma 1.67 0.11 15.8 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 2 successive function values within tolerance limit 7 outer iterations, barrier value 0.0002481 -------------------------------------------- > all.equal( mlBfgsCon[-c(3,4,9,11)], mlgBfgsCon[-c(3,4,9,11)], tolerance = 1e-2 ) [1] TRUE > mlgBfgsConInd <- maxLik( llfInd, gfInd, start = startVal, constraints = eqCon, + method = "BFGS" ) > all.equal( mlgBfgsCon[], mlgBfgsConInd[-12], tolerance = 1e-3 ) [1] TRUE > mlgBfgsConInd[12] $gradientObs mu sigma [1,] -0.335092 -0.41114 [2,] -0.098314 -0.58255 [3,] 1.184065 1.74311 [4,] 0.117235 -0.57573 [5,] 0.159372 -0.55627 [6,] 1.296151 2.20745 [7,] 0.397103 -0.33530 [8,] -0.840181 0.58039 [9,] -0.425686 -0.29601 [10,] -0.252786 -0.49196 [11,] 0.944185 0.89037 [12,] 0.324627 -0.42267 [13,] 0.353987 -0.38939 [14,] 0.146035 -0.56307 [15,] -0.331769 -0.41484 [16,] 1.347656 2.43490 [17,] 0.423579 -0.29900 [18,] -1.343098 2.41441 [19,] 0.569464 -0.05702 [20,] -0.272234 -0.47490 [21,] -0.698789 0.21693 [22,] -0.089567 -0.58529 [23,] -0.668810 0.14845 [24,] -0.455822 -0.25164 [25,] -0.381375 -0.35575 [26,] -1.142431 1.58132 [27,] 0.667266 0.14501 [28,] 0.176638 -0.54657 [29,] -0.749194 0.33884 [30,] 0.965500 0.95836 [31,] 0.372406 -0.36704 [32,] -0.144834 -0.56365 [33,] 0.708370 0.23945 [34,] 0.696189 0.21088 [35,] 0.655649 0.11934 [36,] 0.560349 -0.07423 [37,] 0.463772 -0.23943 [38,] 0.022309 -0.59786 [39,] -0.152642 -0.55977 [40,] -0.206054 -0.52777 [41,] -0.431317 -0.28795 [42,] -0.082357 -0.58736 [43,] -0.840421 0.58106 [44,] 1.621527 3.79315 [45,] 0.932630 0.85415 [46,] -0.738420 0.31207 [47,] -0.222121 -0.51628 [48,] -0.267836 -0.47887 [49,] 0.625816 0.05548 [50,] 0.006927 -0.59861 [51,] 0.248284 -0.49572 [52,] 0.046227 -0.59512 [53,] 0.035959 -0.59653 [54,] 1.047786 1.23507 [55,] -0.095155 -0.58357 [56,] 1.153787 1.62487 [57,] -1.043548 1.22027 [58,] 0.485777 -0.20453 [59,] 0.155477 -0.55831 [60,] 0.221490 -0.51675 [61,] 0.338839 -0.40692 [62,] -0.293405 -0.45490 [63,] -0.172172 -0.54918 [64,] -0.663485 0.13660 [65,] -0.701633 0.22359 [66,] 0.284278 -0.46371 [67,] 0.387994 -0.34724 [68,] 0.104687 -0.58038 [69,] 0.727827 0.28613 [70,] 1.536313 3.34368 [71,] -0.285310 -0.46272 [72,] -1.588659 3.61691 [73,] 0.787664 0.43760 [74,] -0.441707 -0.27280 [75,] -0.426515 -0.29484 [76,] 0.801881 0.47534 [77,] -0.137452 -0.56713 [78,] -0.808392 0.49286 [79,] 0.196660 -0.53409 [80,] -0.032875 -0.59688 [81,] 0.070823 -0.59031 [82,] 0.342883 -0.40231 [83,] -0.199021 -0.53253 [84,] 0.528618 -0.13194 [85,] -0.091367 -0.58475 [86,] 0.304532 -0.44379 [87,] 0.852970 0.61656 [88,] 0.378655 -0.35920 [89,] -0.166957 -0.55213 [90,] 0.890224 0.72503 [91,] 0.778893 0.41465 [92,] 0.459814 -0.24554 [93,] 0.237828 -0.50421 [94,] -0.383430 -0.35312 [95,] 1.042087 1.21518 [96,] -0.363611 -0.37785 [97,] 1.634701 3.86480 [98,] 1.165357 1.66969 [99,] -0.102273 -0.58122 [100,] -0.669109 0.14912 > > # with analytical gradients and unused Hessians > mlghBfgsCon <- maxLik( llf, gf, hf, start = startVal, constraints = eqCon, + method = "BFGS" ) > all.equal( mlgBfgsCon, mlghBfgsCon, tolerance = 1e-3 ) [1] TRUE > > ## NM method with equality constraints > mlNmCon <- maxLik( llf, start = startVal, constraints = eqCon, method = "NM", SUMTTol=0) > print( mlNmCon ) Maximum Likelihood estimation Nelder-Mead maximization, 57 iterations Return code 0: successful convergence Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.8199 1.68 > print( summary( mlNmCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 57 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 10 outer iterations, barrier value 2.152e-10 -------------------------------------------- > activePar( mlNmCon ) mu sigma TRUE TRUE > AIC( mlNmCon ) [1] 413.1 attr(,"df") [1] 2 > coef( mlNmCon ) mu sigma 0.8199 1.6801 > condiNumber( mlNmCon, digits = 3 ) mu 1 sigma 3.61 > round( hessian( mlNmCon ), 1 ) mu sigma mu -35.4 -15.2 sigma -15.2 -93.7 > logLik( mlNmCon ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlNmCon ) [1] "Nelder-Mead maximization" > nIter( mlNmCon ) function 57 > nParam( mlNmCon ) [1] 2 > returnCode( mlNmCon ) [1] 0 > returnMessage( mlNmCon ) [1] "successful convergence " > round( vcov( mlNmCon ), 3 ) mu sigma mu 0.030 -0.005 sigma -0.005 0.011 > logLik( summary( mlNmCon ) ) [1] -204.5 attr(,"df") [1] 2 > all.equal( mlNmCon[ -c( 4, 5, 6, 9, 10 ) ], mlGCon[ -c( 4, 5, 6, 9, 10 ) ], + tolerance = 1e-3 ) [1] "Names: 3 string mismatches" [2] "Component \"estimate\": Mean relative difference: 0.01283" [3] "Component \"gradient\": Mean relative difference: 0.04995" [4] "Component \"last.step\": target is NULL, current is list" [5] "Component 6: Modes: list, S4" [6] "Component 6: Lengths: 5, 1" [7] "Component 6: names for target but not for current" [8] "Component 6: Attributes: < names for current but not for target >" [9] "Component 6: Attributes: < Length mismatch: comparison on first 0 components >" [10] "Component 6: current is not list-like" [11] "Component 7: Modes: S4, function" [12] "Component 7: Attributes: < Modes: list, NULL >" [13] "Component 7: Attributes: < Lengths: 20, 0 >" [14] "Component 7: Attributes: < names for target but not for current >" [15] "Component 7: Attributes: < current is not list-like >" [16] "Component 8: Modes of target, current: function, list" [17] "Component 8: target, current do not match when deparsed" > mlNmConInd <- maxLik( llfInd, start = startVal, constraints = eqCon, + method = "NM", SUMTTol=0) > print( summary( mlNmConInd ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 57 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 10 outer iterations, barrier value 2.152e-10 -------------------------------------------- > all.equal( mlNmCon[], mlNmConInd[-12], tolerance = 1e-3 ) [1] TRUE > mlNmConInd[12] $gradientObs mu sigma [1,] -0.333308 -0.40855 [2,] -0.099285 -0.57864 [3,] 1.168181 1.69756 [4,] 0.113758 -0.57346 [5,] 0.155405 -0.55462 [6,] 1.278964 2.15304 [7,] 0.390371 -0.33917 [8,] -0.832523 0.56928 [9,] -0.422849 -0.29479 [10,] -0.251960 -0.48854 [11,] 0.931091 0.86134 [12,] 0.318738 -0.42451 [13,] 0.347757 -0.39201 [14,] 0.142223 -0.56121 [15,] -0.330025 -0.41221 [16,] 1.329870 2.37617 [17,] 0.416540 -0.30369 [18,] -1.329591 2.37492 [19,] 0.560728 -0.06694 [20,] -0.271182 -0.47164 [21,] -0.692776 0.21115 [22,] -0.090639 -0.58140 [23,] -0.663146 0.14365 [24,] -0.452634 -0.25098 [25,] -0.379053 -0.35380 [26,] -1.131259 1.55492 [27,] 0.657392 0.13089 [28,] 0.172470 -0.54522 [29,] -0.742594 0.33129 [30,] 0.952158 0.92800 [31,] 0.365961 -0.37019 [32,] -0.145263 -0.55975 [33,] 0.698018 0.22340 [34,] 0.685979 0.19541 [35,] 0.645910 0.10574 [36,] 0.551719 -0.08378 [37,] 0.456265 -0.24544 [38,] 0.019936 -0.59453 [39,] -0.152980 -0.55588 [40,] -0.205771 -0.52406 [41,] -0.428414 -0.28683 [42,] -0.083513 -0.58348 [43,] -0.832760 0.56994 [44,] 1.600556 3.70887 [45,] 0.919670 0.82583 [46,] -0.731946 0.30491 [47,] -0.221652 -0.51266 [48,] -0.266834 -0.47557 [49,] 0.616424 0.04321 [50,] 0.004733 -0.59516 [51,] 0.243283 -0.49576 [52,] 0.043575 -0.59201 [53,] 0.033427 -0.59332 [54,] 1.033487 1.19932 [55,] -0.096162 -0.57966 [56,] 1.138255 1.58160 [57,] -1.033525 1.19945 [58,] 0.478013 -0.21130 [59,] 0.151555 -0.55661 [60,] 0.216801 -0.51623 [61,] 0.332785 -0.40913 [62,] -0.292106 -0.45184 [63,] -0.172284 -0.54533 [64,] -0.657882 0.13197 [65,] -0.695587 0.21771 [66,] 0.278858 -0.46455 [67,] 0.381368 -0.35084 [68,] 0.101356 -0.57794 [69,] 0.717249 0.26913 [70,] 1.516333 3.26782 [71,] -0.284105 -0.45959 [72,] -1.572297 3.55823 [73,] 0.776390 0.41754 [74,] -0.438683 -0.27187 [75,] -0.423668 -0.29363 [76,] 0.790442 0.45453 [77,] -0.137967 -0.56322 [78,] -0.801105 0.48304 [79,] 0.192259 -0.53310 [80,] -0.034606 -0.59319 [81,] 0.067885 -0.58746 [82,] 0.336781 -0.40464 [83,] -0.198820 -0.52879 [84,] 0.520357 -0.14027 [85,] -0.092418 -0.58085 [86,] 0.298876 -0.44512 [87,] 0.840937 0.59293 [88,] 0.372137 -0.36253 [89,] -0.167128 -0.54827 [90,] 0.877757 0.69926 [91,] 0.767721 0.39505 [92,] 0.452353 -0.25141 [93,] 0.232948 -0.50403 [94,] -0.381084 -0.35120 [95,] 1.027854 1.17981 [96,] -0.361496 -0.37564 [97,] 1.613576 3.77919 [98,] 1.149691 1.62555 [99,] -0.103198 -0.57731 [100,] -0.663441 0.14431 > nObs( mlNmConInd ) [1] 100 > > # with unused analytical gradients > mlgNmCon <- maxLik( llf, gf, start = startVal, constraints = eqCon, + method = "NM", SUMTTol=0) > all.equal( mlNmCon, mlgNmCon, tolerance = 1e-3 ) [1] TRUE > mlgNmConInd <- maxLik( llfInd, gfInd, start = startVal, constraints = eqCon, + method = "NM", SUMTTol=0) > all.equal( mlgNmCon[], mlgNmConInd[-12], tolerance = 1e-3 ) [1] TRUE > mlgNmConInd[12] $gradientObs mu sigma [1,] -0.333308 -0.40855 [2,] -0.099285 -0.57864 [3,] 1.168181 1.69756 [4,] 0.113758 -0.57346 [5,] 0.155405 -0.55462 [6,] 1.278964 2.15304 [7,] 0.390371 -0.33917 [8,] -0.832523 0.56928 [9,] -0.422849 -0.29479 [10,] -0.251960 -0.48854 [11,] 0.931091 0.86134 [12,] 0.318738 -0.42451 [13,] 0.347757 -0.39201 [14,] 0.142223 -0.56121 [15,] -0.330025 -0.41221 [16,] 1.329870 2.37617 [17,] 0.416540 -0.30369 [18,] -1.329591 2.37492 [19,] 0.560728 -0.06694 [20,] -0.271182 -0.47164 [21,] -0.692776 0.21115 [22,] -0.090639 -0.58140 [23,] -0.663146 0.14365 [24,] -0.452634 -0.25098 [25,] -0.379053 -0.35380 [26,] -1.131259 1.55492 [27,] 0.657392 0.13089 [28,] 0.172470 -0.54522 [29,] -0.742594 0.33129 [30,] 0.952158 0.92800 [31,] 0.365961 -0.37019 [32,] -0.145263 -0.55975 [33,] 0.698018 0.22340 [34,] 0.685979 0.19541 [35,] 0.645910 0.10574 [36,] 0.551719 -0.08378 [37,] 0.456265 -0.24544 [38,] 0.019936 -0.59453 [39,] -0.152980 -0.55588 [40,] -0.205771 -0.52406 [41,] -0.428414 -0.28683 [42,] -0.083513 -0.58348 [43,] -0.832760 0.56994 [44,] 1.600556 3.70887 [45,] 0.919670 0.82583 [46,] -0.731946 0.30491 [47,] -0.221652 -0.51266 [48,] -0.266834 -0.47557 [49,] 0.616424 0.04321 [50,] 0.004733 -0.59516 [51,] 0.243283 -0.49576 [52,] 0.043575 -0.59201 [53,] 0.033427 -0.59332 [54,] 1.033487 1.19932 [55,] -0.096162 -0.57966 [56,] 1.138255 1.58160 [57,] -1.033525 1.19945 [58,] 0.478013 -0.21130 [59,] 0.151555 -0.55661 [60,] 0.216801 -0.51623 [61,] 0.332785 -0.40913 [62,] -0.292106 -0.45184 [63,] -0.172284 -0.54533 [64,] -0.657882 0.13197 [65,] -0.695587 0.21771 [66,] 0.278858 -0.46455 [67,] 0.381368 -0.35084 [68,] 0.101356 -0.57794 [69,] 0.717249 0.26913 [70,] 1.516333 3.26782 [71,] -0.284105 -0.45959 [72,] -1.572297 3.55823 [73,] 0.776390 0.41754 [74,] -0.438683 -0.27187 [75,] -0.423668 -0.29363 [76,] 0.790442 0.45453 [77,] -0.137967 -0.56322 [78,] -0.801105 0.48304 [79,] 0.192259 -0.53310 [80,] -0.034606 -0.59319 [81,] 0.067885 -0.58746 [82,] 0.336781 -0.40464 [83,] -0.198820 -0.52879 [84,] 0.520357 -0.14027 [85,] -0.092418 -0.58085 [86,] 0.298876 -0.44512 [87,] 0.840937 0.59293 [88,] 0.372137 -0.36253 [89,] -0.167128 -0.54827 [90,] 0.877757 0.69926 [91,] 0.767721 0.39505 [92,] 0.452353 -0.25141 [93,] 0.232948 -0.50403 [94,] -0.381084 -0.35120 [95,] 1.027854 1.17981 [96,] -0.361496 -0.37564 [97,] 1.613576 3.77919 [98,] 1.149691 1.62555 [99,] -0.103198 -0.57731 [100,] -0.663441 0.14431 > > # with unused analytical gradients and Hessians > mlghNmCon <- maxLik( llf, gf, hf, start = startVal, constraints = eqCon, + method = "NM", SUMTTol=0) > all.equal( mlgNmCon, mlghNmCon, tolerance = 1e-3 ) [1] TRUE > > ## SANN method with equality constraints > mlSannCon <- maxLik( llf, start = startVal, constraints = eqCon, + method = "SANN", SUMTTol=0) > print( mlSannCon ) Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -204.5 (2 free parameter(s)) Estimate(s): 0.816 1.684 > print( summary( mlSannCon ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -204.5 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.82 0.17 4.7 3e-06 *** sigma 1.68 0.11 15.6 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 1 penalty close to zero 9 outer iterations, barrier value 1.234e-09 -------------------------------------------- > activePar( mlSannCon ) mu sigma TRUE TRUE > AIC( mlSannCon ) [1] 413.1 attr(,"df") [1] 2 > coef( mlSannCon ) mu sigma 0.816 1.684 > condiNumber( mlSannCon, digits = 3 ) mu 1 sigma 3.62 > round( hessian( mlSannCon ), 1 ) mu sigma mu -35.3 -15.3 sigma -15.3 -92.8 > logLik( mlSannCon ) [1] -204.5 attr(,"df") [1] 2 > maximType( mlSannCon ) [1] "SANN maximization" > nIter( mlSannCon ) function 10000 > nParam( mlSannCon ) [1] 2 > returnCode( mlSannCon ) [1] 0 > returnMessage( mlSannCon ) [1] "successful convergence " > round( vcov( mlSannCon ), 3 ) mu sigma mu 0.031 -0.005 sigma -0.005 0.012 > logLik( summary( mlSannCon ) ) [1] -204.5 attr(,"df") [1] 2 > all.equal( mlSannCon[ -c(2,3,4,5,6,9,10,11) ], mlBfgsCon[ -c(2,3,4,5,6,9,10,11) ], + tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 0.98 >" > all.equal( mlSannCon[ -c(3,4,5,6,9,10,11) ], mlBfgsCon[ -c(3,4,5,6,9,10,11) ], + tolerance = 1e-2 ) [1] "Component \"control\": Attributes: < Component \"iterlim\": Mean relative difference: 0.98 >" > > # with unused analytical gradients > mlgSannCon <- maxLik( llf, gf, start = startVal, constraints = eqCon, + method = "SANN", SUMTTol=0) > all.equal( mlSannCon, mlgSannCon, tolerance = 1e-3 ) [1] TRUE > > # with a user-specified function to generate a new candidate point > mlSannConCand <- maxLik( llf, start = startVal, constraints = eqCon, + method = "SANN", cand = function(x)c(rnorm(1,x[1]),rnorm(1,x[2])) ) Warning message: In (function (fn, grad = NULL, hess = NULL, start, maxRoutine, constraints, : problem in imposing equality constraints: the constraints are not satisfied (barrier value = 0.254780368286163). Try setting 'SUMTTol' to 0 > print( summary( mlSannConCand ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation SANN maximization, 10000 iterations Return code 0: successful convergence Log-Likelihood: -201.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.18 0.18 6.5 8e-11 *** sigma 1.82 0.13 14.1 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on SUMT Return code: 2 successive function values within tolerance limit 2 outer iterations, barrier value 0.2548 -------------------------------------------- > all.equal( mlSannConCand[-c(1,2,3,4,11)], mlSannCon[-c(1,2,3,4,11)], + tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"sann_cand\": Modes of target, current: function, name >" [2] "Component \"control\": Attributes: < Component \"sann_cand\": target, current do not match when deparsed >" > all.equal( mlSannConCand[-c(2,3,4,11)], mlSannCon[-c(2,3,4,11)], + tolerance = 1e-1 ) [1] "Component \"control\": Attributes: < Component \"sann_cand\": Modes of target, current: function, name >" [2] "Component \"control\": Attributes: < Component \"sann_cand\": target, current do not match when deparsed >" > > > ## test for method "estfun" > library( sandwich ) > try( estfun( ml ) ) Error in estfun.maxLik(ml) : cannot return the gradients of the log-likelihood function evaluated at each observation: please re-run 'maxLik' and provide a gradient function using argument 'grad' or (if no gradient function is specified) a log-likelihood function using argument 'logLik' that return the gradients or log-likelihood values, respectively, at each observation > estfun( mlInd )[ 1:5, ] mu sigma [1,] -0.39452 -0.2678 [2,] -0.19432 -0.4819 [3,] 0.88999 0.8883 [4,] -0.01206 -0.5503 [5,] 0.02357 -0.5495 > estfun( mlgInd )[ 1:5, ] mu sigma [1,] -0.39452 -0.2678 [2,] -0.19432 -0.4819 [3,] 0.88999 0.8883 [4,] -0.01206 -0.5503 [5,] 0.02357 -0.5495 > estfun( mlBHHH )[ 1:5, ] mu sigma [1,] -0.39452 -0.2678 [2,] -0.19431 -0.4819 [3,] 0.88998 0.8883 [4,] -0.01206 -0.5502 [5,] 0.02357 -0.5495 > estfun( mlgBHHH )[ 1:5, ] mu sigma [1,] -0.39452 -0.2678 [2,] -0.19431 -0.4819 [3,] 0.88998 0.8883 [4,] -0.01206 -0.5502 [5,] 0.02357 -0.5495 > estfun( mlIndBFGS )[ 1:5, ] mu sigma [1,] -0.39452 -0.2678 [2,] -0.19432 -0.4819 [3,] 0.88999 0.8883 [4,] -0.01206 -0.5503 [5,] 0.02357 -0.5495 > estfun( mlgIndBFGS )[ 1:5, ] mu sigma [1,] -0.39452 -0.2678 [2,] -0.19432 -0.4819 [3,] 0.88999 0.8883 [4,] -0.01206 -0.5503 [5,] 0.02357 -0.5495 > estfun( mlIndNM )[ 1:5, ] mu sigma [1,] -0.39439 -0.2679 [2,] -0.19422 -0.4819 [3,] 0.88990 0.8882 [4,] -0.01200 -0.5502 [5,] 0.02363 -0.5495 > estfun( mlgIndNM )[ 1:5, ] mu sigma [1,] -0.39439 -0.2679 [2,] -0.19422 -0.4819 [3,] 0.88990 0.8882 [4,] -0.01200 -0.5502 [5,] 0.02363 -0.5495 > estfun( mlIndSANN )[ 1:5, ] mu sigma [1,] -0.39480 -0.2674 [2,] -0.19460 -0.4817 [3,] 0.88966 0.8873 [4,] -0.01235 -0.5502 [5,] 0.02327 -0.5495 > estfun( mlgIndSANN )[ 1:5, ] mu sigma [1,] -0.39480 -0.2674 [2,] -0.19460 -0.4817 [3,] 0.88966 0.8873 [4,] -0.01235 -0.5502 [5,] 0.02327 -0.5495 > estfun( mlIndFix )[ 1:5, ] mu sigma [1,] NA -0.3412 [2,] NA -0.5130 [3,] NA 1.0498 [4,] NA -0.5445 [5,] NA -0.5368 > estfun( mlgIndFix )[ 1:5, ] mu sigma [1,] NA -0.3412 [2,] NA -0.5130 [3,] NA 1.0498 [4,] NA -0.5445 [5,] NA -0.5368 > estfun( mlFixBHHH )[ 1:5, ] mu sigma [1,] NA -0.3412 [2,] NA -0.5130 [3,] NA 1.0498 [4,] NA -0.5445 [5,] NA -0.5368 > estfun( mlgFixBHHH )[ 1:5, ] mu sigma [1,] NA -0.3412 [2,] NA -0.5130 [3,] NA 1.0498 [4,] NA -0.5445 [5,] NA -0.5368 > estfun( mlIndFixBfgs )[ 1:5, ] mu sigma [1,] -0.33639 -0.3412 [2,] -0.13815 -0.5130 [3,] 0.93552 1.0498 [4,] 0.04232 -0.5445 [5,] 0.07760 -0.5368 > estfun( mlgIndFixBfgs )[ 1:5, ] mu sigma [1,] -0.33639 -0.3412 [2,] -0.13815 -0.5130 [3,] 0.93552 1.0498 [4,] 0.04232 -0.5445 [5,] 0.07760 -0.5368 > estfun( mlIndFixNm )[ 1:5, ] mu sigma [1,] -0.33627 -0.3413 [2,] -0.13810 -0.5129 [3,] 0.93518 1.0491 [4,] 0.04230 -0.5444 [5,] 0.07757 -0.5367 > estfun( mlgIndFixNm )[ 1:5, ] mu sigma [1,] -0.33627 -0.3413 [2,] -0.13810 -0.5129 [3,] 0.93518 1.0491 [4,] 0.04230 -0.5444 [5,] 0.07757 -0.5367 > estfun( mlIndFixSann )[ 1:5, ] mu sigma [1,] -0.33640 -0.3412 [2,] -0.13815 -0.5130 [3,] 0.93553 1.0499 [4,] 0.04232 -0.5445 [5,] 0.07760 -0.5368 > estfun( mlgIndFixSann )[ 1:5, ] mu sigma [1,] -0.33640 -0.3412 [2,] -0.13815 -0.5130 [3,] 0.93553 1.0499 [4,] 0.04232 -0.5445 [5,] 0.07760 -0.5368 > estfun( mlBfgsInEqInd )[ 1:5, ] mu sigma [1,] -0.3332 -0.4086 [2,] -0.0992 -0.5786 [3,] 1.1680 1.6972 [4,] 0.1138 -0.5734 [5,] 0.1554 -0.5545 > estfun( mlgBfgsInEqInd )[ 1:5, ] mu sigma [1,] -0.3332 -0.4086 [2,] -0.0992 -0.5786 [3,] 1.1680 1.6972 [4,] 0.1138 -0.5734 [5,] 0.1554 -0.5545 > estfun( mlNmInEqInd )[ 1:5, ] mu sigma [1,] -0.3332 -0.4086 [2,] -0.0992 -0.5786 [3,] 1.1680 1.6972 [4,] 0.1138 -0.5734 [5,] 0.1554 -0.5545 > estfun( mlBhhhCon )[ 1:5, ] mu sigma [1,] -0.3336 -0.4084 [2,] -0.0995 -0.5787 [3,] 1.1686 1.6986 [4,] 0.1137 -0.5737 [5,] 0.1553 -0.5548 > estfun( mlgBhhhCon )[ 1:5, ] mu sigma [1,] -0.3440 -0.4030 [2,] -0.1060 -0.5815 [3,] 1.1828 1.7307 [4,] 0.1106 -0.5798 [5,] 0.1530 -0.5612 > estfun( mlBfgsConInd )[ 1:5, ] mu sigma [1,] -0.33319 -0.4086 [2,] -0.09921 -0.5786 [3,] 1.16802 1.6972 [4,] 0.11379 -0.5734 [5,] 0.15543 -0.5546 > estfun( mlgBfgsConInd )[ 1:5, ] mu sigma [1,] -0.33509 -0.4111 [2,] -0.09831 -0.5825 [3,] 1.18407 1.7431 [4,] 0.11724 -0.5757 [5,] 0.15937 -0.5563 > estfun( mlNmConInd )[ 1:5, ] mu sigma [1,] -0.33331 -0.4085 [2,] -0.09928 -0.5786 [3,] 1.16818 1.6976 [4,] 0.11376 -0.5735 [5,] 0.15540 -0.5546 > estfun( mlgNmConInd )[ 1:5, ] mu sigma [1,] -0.33331 -0.4085 [2,] -0.09928 -0.5786 [3,] 1.16818 1.6976 [4,] 0.11376 -0.5735 [5,] 0.15540 -0.5546 > > > ## test for method "bread" > try( bread( ml ) ) Error in nObs.maxLik(x) : cannot return the number of observations: please re-run 'maxLik' and provide a gradient function using argument 'grad' or (if no gradient function is specified) a log-likelihood function using argument 'logLik' that return the gradients or log-likelihood values, respectively, at each observation > round( bread( mlInd ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlgInd ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlBHHH ), 2 ) mu sigma mu 3.31 -0.11 sigma -0.11 1.80 > round( bread( mlgBHHH ), 2 ) mu sigma mu 3.31 -0.11 sigma -0.11 1.80 > round( bread( mlIndBFGS ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlgIndBFGS ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlIndNM ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlgIndNM ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlIndSANN ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlgIndSANN ), 2 ) mu sigma mu 3.3 0.00 sigma 0.0 1.65 > round( bread( mlIndFix ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlgIndFix ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlFixBHHH ), 2 ) mu sigma mu 0 0.00 sigma 0 1.79 > round( bread( mlgFixBHHH ), 2 ) mu sigma mu 0 0.00 sigma 0 1.79 > round( bread( mlIndFixBfgs ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlgIndFixBfgs ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlIndFixNm ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlgIndFixNm ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlIndFixSann ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlgIndFixSann ), 2 ) mu sigma mu 0 0.00 sigma 0 1.67 > round( bread( mlBfgsInEqInd ), 2 ) mu sigma mu 3.04 -0.49 sigma -0.49 1.15 > round( bread( mlgBfgsInEqInd ), 2 ) mu sigma mu 3.04 -0.49 sigma -0.49 1.15 > round( bread( mlNmInEqInd ), 2 ) mu sigma mu 3.03 -0.49 sigma -0.49 1.15 > round( bread( mlBhhhCon ), 2 ) mu sigma mu 3.03 -0.49 sigma -0.49 1.15 > round( bread( mlgBhhhCon ), 2 ) mu sigma mu 2.97 -0.46 sigma -0.46 1.10 > round( bread( mlBfgsConInd ), 2 ) mu sigma mu 3.04 -0.49 sigma -0.49 1.15 > round( bread( mlgBfgsConInd ), 2 ) mu sigma mu 3.01 -0.49 sigma -0.49 1.12 > round( bread( mlNmConInd ), 2 ) mu sigma mu 3.04 -0.49 sigma -0.49 1.15 > round( bread( mlgNmConInd ), 2 ) mu sigma mu 3.03 -0.49 sigma -0.49 1.15 > > > ## test for method "sandwich" > try( sandwich( ml ) ) Error in nObs.maxLik(x) : cannot return the number of observations: please re-run 'maxLik' and provide a gradient function using argument 'grad' or (if no gradient function is specified) a log-likelihood function using argument 'logLik' that return the gradients or log-likelihood values, respectively, at each observation > printSandwich <- function( x ) { + print( round( sandwich( x ), 2 ) ) + tmp <- all.equal( sandwich( x ), vcov( x ) ) + if( isTRUE( tmp ) ) { + print( tmp ) + } + } > printSandwich( mlInd ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlgInd ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlBHHH ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 [1] TRUE > printSandwich( mlgBHHH ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 [1] TRUE > printSandwich( mlIndBFGS ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlgIndBFGS ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlIndNM ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlgIndNM ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlIndSANN ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlgIndSANN ) mu sigma mu 0.03 0.00 sigma 0.00 0.02 > printSandwich( mlIndFix ) mu sigma mu NA NA sigma NA NA > printSandwich( mlgIndFix ) mu sigma mu NA NA sigma NA NA > printSandwich( mlFixBHHH ) mu sigma mu NA NA sigma NA NA > printSandwich( mlgFixBHHH ) mu sigma mu NA NA sigma NA NA > printSandwich( mlIndFixBfgs ) mu sigma mu 0 0.00 sigma 0 0.02 > printSandwich( mlgIndFixBfgs ) mu sigma mu 0 0.00 sigma 0 0.02 > printSandwich( mlIndFixNm ) mu sigma mu 0 0.00 sigma 0 0.02 > printSandwich( mlgIndFixNm ) mu sigma mu 0 0.00 sigma 0 0.02 > printSandwich( mlIndFixSann ) mu sigma mu 0 0.00 sigma 0 0.02 > printSandwich( mlgIndFixSann ) mu sigma mu 0 0.00 sigma 0 0.02 > printSandwich( mlBfgsInEqInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlgBfgsInEqInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlNmInEqInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlBhhhCon ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlgBhhhCon ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlBfgsConInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlgBfgsConInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlNmConInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > printSandwich( mlgNmConInd ) mu sigma mu 0.04 0.00 sigma 0.00 0.01 > > proc.time() user system elapsed 20.727 1.947 19.910 maxLik/tests/methods.Rout.save0000644000176200001440000001130712660520442016117 0ustar liggesusers R version 3.2.3 (2015-12-10) -- "Wooden Christmas-Tree" Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-redhat-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## Test methods. Note: only test if methods work in terms of dim, length, etc, > ## not in terms of values here > > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > require(testthat) Loading required package: testthat > require(sandwich) Loading required package: sandwich > set.seed(0) > > ## Test standard methods for "lm" > x <- runif(20) > y <- x + rnorm(20) > m <- lm(y ~ x) > print(nObs(m)) [1] 20 > print(stdEr(m)) (Intercept) x 0.3578623 0.5687071 > > ## Test maxControl methods: > set.seed(9) > x <- rnorm(20, sd=2) > ll1 <- function(par) dnorm(x, mean=par, sd=1, log=TRUE) > ll2 <- function(par) dnorm(x, mean=par[1], sd=par[2], log=TRUE) > for(method in c("NR", "BFGS", "BFGSR")) { + cat("-- method", method, "--\n") + m <- maxLik(ll2, start=c(0, 2), method=method, control=list(iterlim=1)) + expect_equal(maxValue(m), -41.35, tolerance=0.01) + expect_true(is.vector(gradient(m)), info="'gradient' returns a vector") + expect_equal(length(gradient(m)), 2, info="'gradient(m)' is of length 2") + expect_true(is.matrix(estfun(m)), info="'estfun' returns a matrix") + expect_equal(dim(estfun(m)), c(20,2), info="'estfun(m)' is 20x2 matrix") + cat("MaxControl structure:\n") + show(maxControl(m)) + } -- method NR -- MaxControl structure: A 'MaxControl' object with slots: tol = 1e-08 reltol = 1.490116e-08 gradtol = 1e-06 steptol = 1e-10 lambdatol = 1e-06 qrtol = 1e-10 qac = stephalving marquardt_lambda0 = 0.01 marquardt_lambdaStep = 2 marquardt_maxLambda = 1e+12 nm_alpha = 1 nm_beta = 0.5 nm_gamma = 2 sann_cand = sann_temp = 10 sann_tmax = 10 sann_randomSeed = 123 iterlim = 1 printLevel = 0 -- method BFGS -- MaxControl structure: A 'MaxControl' object with slots: tol = 1e-08 reltol = 1.490116e-08 gradtol = 1e-06 steptol = 1e-10 lambdatol = 1e-06 qrtol = 1e-10 qac = stephalving marquardt_lambda0 = 0.01 marquardt_lambdaStep = 2 marquardt_maxLambda = 1e+12 nm_alpha = 1 nm_beta = 0.5 nm_gamma = 2 sann_cand = sann_temp = 10 sann_tmax = 10 sann_randomSeed = 123 iterlim = 1 printLevel = 0 -- method BFGSR -- MaxControl structure: A 'MaxControl' object with slots: tol = 1e-08 reltol = 1.490116e-08 gradtol = 1e-06 steptol = 1e-10 lambdatol = 1e-06 qrtol = 1e-10 qac = stephalving marquardt_lambda0 = 0.01 marquardt_lambdaStep = 2 marquardt_maxLambda = 1e+12 nm_alpha = 1 nm_beta = 0.5 nm_gamma = 2 sann_cand = sann_temp = 10 sann_tmax = 10 sann_randomSeed = 123 iterlim = 1 printLevel = 0 > > ## Test methods for non-likelihood optimization > hatf <- function(theta) exp(- theta %*% theta) > for(optimizer in c(maxNR, maxBFGSR, maxBFGS, maxNM, maxSANN, maxCG)) { + name <- as.character(quote(optimizer)) + res <- optimizer(hatf, start=c(1,1)) + if(name %in% c("maxNR", "maxBFGS", "maxNM", "maxCG")) { + expect_equal(coef(res), c(0,0), tol=1e-5, + info=paste0(name, ": result (0,0)")) + } + expect_equal(objectiveFn(res), hatf, info=paste0(name, ": objectiveFn correct")) + } > > ## Test maxLik vcov related methods > set.seed( 15 ) > t <- rexp(20, 2) > loglik <- function(theta) log(theta) - theta*t > gradlik <- function(theta) 1/theta - t > hesslik <- function(theta) -100/theta^2 > a <- maxLik(loglik, start=1) > expect_equal(dim(vcov(a)), c(1,1), info="vcov 1D numeric correct") > expect_equal(length(stdEr(a)), 1, info="stdEr 1D numeric correct") > a <- maxLik(loglik, gradlik, hesslik, start=1) > expect_equal(dim(vcov(a)), c(1,1), info="vcov 1D analytic correct") > expect_equal(length(stdEr(a)), 1, info="stdEr 1D analytic correct") > > proc.time() user system elapsed 1.128 0.036 1.157 maxLik/tests/parameters_privateTest.Rout.save0000644000176200001440000006201112612772357021222 0ustar liggesusers R version 3.2.2 (2015-08-14) -- "Fire Safety" Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-redhat-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > ### Test battery for various optimization parameters for different optimizers. > ### > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > options(digits = 4) > # just to avoid so many differences when comparing these output files > ## data to fit a normal distribution > set.seed( 123 ) > # generate a variable from normally distributed random numbers > N <- 50 > x <- rnorm(N, 1, 2 ) > > ## log likelihood function > llf <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + N <- length( x ) + llValue <- -0.5 * N * log( 2 * pi ) - N * log( sigma ) - + 0.5 * sum( ( x - mu )^2 / sigma^2 ) + return( llValue ) + } > > # start values > startVal <- c( mu = 0, sigma = 1 ) > > # > ml <- maxLik( llf, start = startVal ) > print(summary(ml)) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -101.2 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.069 0.259 4.12 3.7e-05 *** sigma 1.833 0.183 10.00 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > ## tol > mlTol <- maxLik( llf, start = startVal, tol=1) > print(summary(mlTol)) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 4 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -101.3 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.060 0.253 4.18 2.9e-05 *** sigma 1.791 0.173 10.35 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlTolC <- maxLik(llf, start=startVal, control=list(tol=1)) > print(all.equal(mlTol, mlTolC)) [1] TRUE > try(ml <- maxLik( llf, start = startVal, tol=-1)) Error in validObject(x) : invalid class "MaxControl" object: 'tol' must be non-negative, not -1 > try(ml <- maxLik( llf, start = startVal, tol=c(1,2))) Error in validObject(x) : invalid class "MaxControl" object: 'tol' must be of length 1, not 2 In addition: Warning message: In if (slot(object, "tol") < 0) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, tol=TRUE)) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'tol' in an object of class "MaxControl"; is(value, "numeric") is not TRUE > try(ml <- maxLik( llf, start = startVal, control=list(tol=-1))) Error in validObject(x) : invalid class "MaxControl" object: 'tol' must be non-negative, not -1 > try(ml <- maxLik( llf, start = startVal, control=list(tol=c(1,2)))) Error in validObject(x) : invalid class "MaxControl" object: 'tol' must be of length 1, not 2 In addition: Warning message: In if (slot(object, "tol") < 0) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, control=list(tol=TRUE))) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'tol' in an object of class "MaxControl"; is(value, "numeric") is not TRUE > ## reltol > mlRelTol <- maxLik( llf, start = startVal, reltol=1) > print(summary(mlRelTol)) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 1 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -118.3 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 0.741 0.167 4.43 9.2e-06 *** sigma 1.153 0.064 18.02 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlRelTolC <- maxLik(llf, start=startVal, control=list(reltol=1)) > print(all.equal(mlRelTol, mlRelTolC)) [1] TRUE > try(ml <- maxLik( llf, start = startVal, reltol=-1)) Error in validObject(x) : invalid class "MaxControl" object: 'reltol' must be non-negative, not -1 > try(ml <- maxLik( llf, start = startVal, reltol=c(1,2))) Error in validObject(x) : invalid class "MaxControl" object: 'reltol' must be of length 1, not 2 In addition: Warning message: In if (slot(object, "reltol") < 0) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, reltol=TRUE)) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'reltol' in an object of class "MaxControl"; is(value, "numeric") is not TRUE > try(ml <- maxLik( llf, start = startVal, control=list(reltol=-1))) Error in validObject(x) : invalid class "MaxControl" object: 'reltol' must be non-negative, not -1 > try(ml <- maxLik( llf, start = startVal, control=list(reltol=c(1,2)))) Error in validObject(x) : invalid class "MaxControl" object: 'reltol' must be of length 1, not 2 In addition: Warning message: In if (slot(object, "reltol") < 0) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, control=list(reltol=TRUE))) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'reltol' in an object of class "MaxControl"; is(value, "numeric") is not TRUE > ## gradtol > mlGradtol <- maxLik( llf, start = startVal, gradtol=1e-2) > print(summary(mlGradtol)) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 1: gradient close to zero Log-Likelihood: -101.2 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.069 0.259 4.12 3.7e-05 *** sigma 1.833 0.183 10.00 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlGradtolC <- maxLik(llf, start=startVal, control=list(gradtol=1e-2)) > print(all.equal(mlGradtol, mlGradtolC)) [1] TRUE > try(ml <- maxLik( llf, start = startVal, gradtol=-1)) Error in validObject(x) : invalid class "MaxControl" object: 'gradtol' must be non-negative, not -1 > try(ml <- maxLik( llf, start = startVal, gradtol=c(1,2))) Error in validObject(x) : invalid class "MaxControl" object: 'gradtol' must be of length 1, not 2 In addition: Warning message: In if (slot(object, "gradtol") < 0) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, gradtol=TRUE)) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'gradtol' in an object of class "MaxControl"; is(value, "numeric") is not TRUE > try(ml <- maxLik( llf, start = startVal, control=list(gradtol=-1))) Error in validObject(x) : invalid class "MaxControl" object: 'gradtol' must be non-negative, not -1 > try(ml <- maxLik( llf, start = startVal, control=list(gradtol=c(1,2)))) Error in validObject(x) : invalid class "MaxControl" object: 'gradtol' must be of length 1, not 2 In addition: Warning message: In if (slot(object, "gradtol") < 0) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, control=list(gradtol=TRUE))) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'gradtol' in an object of class "MaxControl"; is(value, "numeric") is not TRUE > ## examples with steptol, lambdatol > ## qac > mlMarq <- maxLik( llf, start = startVal, qac="marquardt") > print(summary(mlMarq)) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation with Marquardt (1963) Hessian correction, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -101.2 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.069 0.259 4.12 3.7e-05 *** sigma 1.833 0.183 10.00 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlMarqC <- maxLik(llf, start=startVal, control=list(qac="marquardt")) > print(all.equal(mlMarq, mlMarqC)) [1] TRUE > try(ml <- maxLik( llf, start = startVal, qac=-1)) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "numeric" is not valid for slot 'qac' in an object of class "MaxControl"; is(value, "character") is not TRUE > try(ml <- maxLik( llf, start = startVal, qac=c("a", "b"))) Error in if (!pmatch(slot(object, "qac"), c("stephalving", "marquardt"))) { : missing value where TRUE/FALSE needed In addition: Warning message: In if (!pmatch(slot(object, "qac"), c("stephalving", "marquardt"))) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, qac=TRUE)) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'qac' in an object of class "MaxControl"; is(value, "character") is not TRUE > try(ml <- maxLik( llf, start = startVal, control=list(qac=-1))) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "numeric" is not valid for slot 'qac' in an object of class "MaxControl"; is(value, "character") is not TRUE > try(ml <- maxLik( llf, start = startVal, control=list(qac=c("a", "b")))) Error in if (!pmatch(slot(object, "qac"), c("stephalving", "marquardt"))) { : missing value where TRUE/FALSE needed In addition: Warning message: In if (!pmatch(slot(object, "qac"), c("stephalving", "marquardt"))) { : the condition has length > 1 and only the first element will be used > try(ml <- maxLik( llf, start = startVal, control=list(qac=TRUE))) Error in checkSlotAssignment(object, name, value) : assignment of an object of class "logical" is not valid for slot 'qac' in an object of class "MaxControl"; is(value, "character") is not TRUE > mlMarqCl <- a <- maxLik(llf, start = startVal, + control=list(qac="marquardt", lambda0=1000, lambdaStep=4)) > print(all.equal(coef(mlMarqCl), coef(mlMarq))) [1] TRUE > ## NM: alpha, beta, gamma > mlNM <- maxLik( llf, start = startVal, method="nm") > print(summary(mlNM)) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 61 iterations Return code 0: successful convergence Log-Likelihood: -101.2 2 free parameters Estimates: Estimate Std. error t value Pr(> t) mu 1.069 0.259 4.12 3.8e-05 *** sigma 1.833 0.183 10.00 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > mlNMAlpha <- maxLik(llf, start=startVal, method="nm", beta=0.8) > mlNMAlphaC <- maxLik(llf, start=startVal, method="nm", control=list(beta=0.8)) > print(all.equal(mlNMAlpha, mlNMAlphaC)) [1] TRUE > > ## likelihood function with additional parameter > llf1 <- function( param, sigma ) { + mu <- param + N <- length( x ) + llValue <- -0.5 * N * log( 2 * pi ) - N * log( sigma ) - + 0.5 * sum( ( x - mu )^2 / sigma^2 ) + return( llValue ) + } > > ## log-lik mixture > logLikMix <- function(param) { + rho <- param[1] + if(rho < 0 || rho > 1) + return(NA) + mu1 <- param[2] + mu2 <- param[3] + ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) + ll + } > > ## loglik mixture with additional parameter > logLikMixA <- function(param, rho) { + mu1 <- param[1] + mu2 <- param[2] + ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) + ll + } > > ## Test the following with all the main optimizers: > for(method in c("NR", "BFGS", "BFGSR")) { + ## two parameters at the same time + ## iterlim, printLevel + cat("-- method", method, "--\n") + N <- 100 + x <- rnorm(N, 1, 2 ) + startVal <- c(1,2) + ml2 <- maxLik( llf, start=startVal, method=method, iterlim=1, printLevel=2) + print(summary(ml2)) + ml2C <- maxLik(llf, start=startVal, method=method, + control=list(iterlim=1, printLevel=2)) + print(all.equal(ml2, ml2C)) + ## what about additional parameters for the loglik function? + mls <- maxLik(llf1, start=0, method=method, sigma=1) + print(coef(mls)) + mlsM <- maxLik(llf1, start=0, method=method, tol=1, sigma=1) + mlsCM <- maxLik(llf1, start=0, method=method, control=list(tol=1), sigma=1) + cat("Additional parameters to loglik: open == control()?\n") + print(all.equal(mlsM, mlsCM)) + ## And what about unused parameters? + cat("What about unused parameters?\n") + try(maxLik(llf1, start=0, method=method, control=list(tol=1), + sigma=1, unusedPar=2)) + # error + N <- 100 + ## Does this work with constraints? + x <- c(rnorm(N, mean=-1), rnorm(N, mean=1)) + ## First test inequality constraints + ## Inequality constraints: x + y + z < 0.5 + A <- matrix(c(-1, 0, 0, + 0, -1, 0, + 0, 0, 1), 3, 3, byrow=TRUE) + B <- rep(0.5, 3) + start <- c(0.4, 0, 0.9) + ## analytic gradient + cat("Inequality constraints, analytic gradient & Hessian\n") + mix <- try(maxLik(logLikMix, + start=start, method=method, + constraints=list(ineqA=A, ineqB=B))) + if(!inherits(mix, "try-error")) { + print(summary(mix)) + } + mixGT <- try(maxLik(logLikMix, + start=start, method=method, + constraints=list(ineqA=A, ineqB=B), + tol=1)) + if(!inherits(mixGT, "try-error")) { + print(summary(mixGT)) + } + mixGTC <- try(maxLik(logLikMix, + start=start, method=method, + constraints=list(ineqA=A, ineqB=B), + control=list(tol=1))) + if(!inherits(mixGTC, "try-error")) { + print(all.equal(mixGT, mixGTC)) + } + ## 2d inequality constraints: x + y < 0.5 + A2 <- matrix(c(-1, -1), 1, 2, byrow=TRUE) + B2 <- 0.5 + start2 <- c(-0.5, 0.5) + cat("Inequality constraints, additional parameters\n") + mixA <- try(maxLik(logLikMixA, + start=start2, method=method, + constraints=list(ineqA=A2, ineqB=B2), + tol=1, + rho=0.5)) + mixAC <- try(maxLik(logLikMixA, + start=start2, method=method, + constraints=list(ineqA=A2, ineqB=B2), + control=list(tol=1), + rho=0.5)) + if(!inherits(mixA, "try-error") & !inherits(mixAC, "try-error")) { + cat("Coefficients equal?\n") + print(all.equal(coef(mixA), coef(mixAC))) + cat("Hessians equal?\n") + print(all.equal(hessian(mixA), hessian(mixAC))) + } + } -- method NR -- ----- Initial parameters: ----- fcn value: -207.4 parameter initial gradient free [1,] 1 -2.687 1 [2,] 2 -3.786 1 Condition number of the (active) hessian: 1.815 -----Iteration 1 ----- -------------- Iteration limit exceeded. 1 iterations estimate: 0.8826 1.907 Function value: -207.1 -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 1 iterations Return code 4: Iteration limit exceeded. Log-Likelihood: -207.1 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.883 0.191 4.63 3.7e-06 *** [2,] 1.907 0.134 14.28 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- ----- Initial parameters: ----- fcn value: -207.4 parameter initial gradient free [1,] 1 -2.687 1 [2,] 2 -3.786 1 Condition number of the (active) hessian: 1.815 -----Iteration 1 ----- -------------- Iteration limit exceeded. 1 iterations estimate: 0.8826 1.907 Function value: -207.1 [1] TRUE [1] 0.8925 Additional parameters to loglik: open == control()? [1] TRUE What about unused parameters? Error in fnOrig(theta, ...) : unused argument (unusedPar = 2) Inequality constraints, analytic gradient & Hessian Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxNR Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxNR Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxNR Inequality constraints, additional parameters Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxNR Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxNR -- method BFGS -- initial value 214.576661 iter 2 value 214.356670 final value 214.356670 stopped after 2 iterations -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 4 iterations Return code 1: iteration limit exceeded Log-Likelihood: -214.4 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.860 0.213 4.03 5.6e-05 *** [2,] 2.135 0.159 13.40 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- initial value 214.576661 iter 2 value 214.356670 final value 214.356670 stopped after 2 iterations [1] TRUE [1] 0.8599 Additional parameters to loglik: open == control()? [1] TRUE What about unused parameters? Error in fnOrig(theta, ...) : unused argument (unusedPar = 2) Inequality constraints, analytic gradient & Hessian -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 149 iterations Return code 0: successful convergence Log-Likelihood: -332.2 3 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.500 0.128 3.92 9e-05 *** [2,] -0.796 0.215 -3.71 0.00021 *** [3,] 0.830 0.247 3.37 0.00076 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.0001908 -------------------------------------------- -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 149 iterations Return code 0: successful convergence Log-Likelihood: -332.2 3 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.500 0.128 3.92 9e-05 *** [2,] -0.796 0.215 -3.71 0.00021 *** [3,] 0.830 0.247 3.37 0.00076 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Warning: constrained likelihood estimation. Inference is probably wrong Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.0001908 -------------------------------------------- [1] TRUE Inequality constraints, additional parameters Coefficients equal? [1] TRUE Hessians equal? [1] TRUE -- method BFGSR -- Initial value of the function : -217.6 -------- Initial parameters: ------- fcn value: -217.6 parameter initial gradient free [1,] 1 1.898 1 [2,] 2 6.419 1 ------------------------------------ Iteration 1 step = 1, lnL = -217.6, chi2 = 0.0004481, function increment = 0.0004479 param gradient direction active [1,] 1 1.897 -1.898e-05 1 [2,] 2 6.415 -6.419e-05 1 -------------------------------------------- -------------- Iteration limit exceeded. 2 iterations estimate: 1 2 Function value: -217.6 -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 2 iterations Return code 4: Iteration limit exceeded. Log-Likelihood: -217.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 1.00 0.20 5.0 5.8e-07 *** [2,] 2.00 0.13 15.4 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- Initial value of the function : -217.6 -------- Initial parameters: ------- fcn value: -217.6 parameter initial gradient free [1,] 1 1.898 1 [2,] 2 6.419 1 ------------------------------------ Iteration 1 step = 1, lnL = -217.6, chi2 = 0.0004481, function increment = 0.0004479 param gradient direction active [1,] 1 1.897 -1.898e-05 1 [2,] 2 6.415 -6.419e-05 1 -------------------------------------------- -------------- Iteration limit exceeded. 2 iterations estimate: 1 2 Function value: -217.6 [1] TRUE [1] 1.076 Additional parameters to loglik: open == control()? [1] TRUE What about unused parameters? Error in fnOrig(theta, ...) : unused argument (unusedPar = 2) Inequality constraints, analytic gradient & Hessian Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxBFGSR Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxBFGSR Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxBFGSR Inequality constraints, additional parameters Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxBFGSR Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxBFGSR > > ### Test adding both default and user-specified parameters through control list > estimate <- function(control=NULL, ...) { + return(maxLik(llf, start=c(1,1), + control=c(list(iterlim=100), control), + ...)) + } > m <- estimate(control=list(iterlim=1), fixed=2) > show(maxControl(m)) A 'MaxControl' object with slots: tol = 1e-08 reltol = 1.49e-08 gradtol = 1e-06 steptol = 1e-10 lambdatol = 1e-06 qrtol = 1e-10 qac = stephalving marquardt_lambda0 = 0.01 marquardt_lambdaStep = 2 marquardt_maxLambda = 1e+12 nm_alpha = 1 nm_beta = 0.5 nm_gamma = 2 sann_cand = sann_temp = 10 sann_tmax = 10 sann_randomSeed = 123 iterlim = 1 printLevel = 0 > # iterlim should be 1 > print(coef(m)) [1] 0.07158 1.00000 > # sigma should be 1.000 > ## Does print.level overwrite 'printLevel'? > m <- estimate(control=list(printLevel=2, print.level=1)) -------------- successive function values within tolerance limit 6 iterations estimate: 0.07169 1.477 Function value: -361.8 > show(maxControl(m)) A 'MaxControl' object with slots: tol = 1e-08 reltol = 1.49e-08 gradtol = 1e-06 steptol = 1e-10 lambdatol = 1e-06 qrtol = 1e-10 qac = stephalving marquardt_lambda0 = 0.01 marquardt_lambdaStep = 2 marquardt_maxLambda = 1e+12 nm_alpha = 1 nm_beta = 0.5 nm_gamma = 2 sann_cand = sann_temp = 10 sann_tmax = 10 sann_randomSeed = 123 iterlim = 100 printLevel = 1 > > ## Does open parameters override everything? > m <- estimate(control=list(printLevel=2, print.level=1), print.level=0) > show(maxControl(m)) A 'MaxControl' object with slots: tol = 1e-08 reltol = 1.49e-08 gradtol = 1e-06 steptol = 1e-10 lambdatol = 1e-06 qrtol = 1e-10 qac = stephalving marquardt_lambda0 = 0.01 marquardt_lambdaStep = 2 marquardt_maxLambda = 1e+12 nm_alpha = 1 nm_beta = 0.5 nm_gamma = 2 sann_cand = sann_temp = 10 sann_tmax = 10 sann_randomSeed = 123 iterlim = 100 printLevel = 0 > > ### does both printLevel, print.level work for condiNumber? > condiNumber(hessian(m), print.level=0) # no output > condiNumber(hessian(m), printLevel=0) # no output > condiNumber(hessian(m), printLevel=0, print.level=1) # no output > > > proc.time() user system elapsed 0.981 0.039 1.014 maxLik/tests/basicTest.Rout.save0000644000176200001440000001337513603262305016403 0ustar liggesusers R version 3.6.2 (2019-12-12) -- "Dark and Stormy Night" 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. 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. > ### general optimization tests for the functions of various forms > ### test for: > ### 1. numeric gradient, Hessian > ### 2. analytic gradient, numeric Hessian > ### 3. analytic gradient, Hessian > ### > ### a) maxLik(, method="NR") > ### c) maxLik(, method="BFGS") > ### b) maxLik(, method="BHHH") > ### > ### i) maxNR() > ### ii) maxBFGS() > > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > library(testthat) > > # log-likelihood function(s) > logLL <- function(x, X) # per observation for maxLik + dgamma(x = X, shape = x[1], scale = x[2], log = TRUE) > logLLSum <- function(x, X) + sum(logLL(x, X)) > > # gradient of log-likelihood function > d.logLL <- function(x, X){ # analytic 1. derivatives + shape <- x[1] + scale <- x[2] + cbind(shape= log(X) - log(scale) - psigamma(shape, 0), + scale= (X/scale - shape)/scale + ) + } > d.logLLSum <- function(x, X) { + ## analytic 1. derivatives, summed + colSums(d.logLL(x, X)) + } > > ## Hessian of log-likelihood function > dd.logLL <- function(x, X){ # analytic 2. derivatives + shape <- x[1] + scale <- x[2] + hessian <- matrix(0, 2, 2) + hessian[1,1] <- -psigamma(shape, 1)*length(X) + hessian[2,2] <- (shape*length(X) - 2*sum(X)/scale)/scale^2 + hessian[cbind(c(2,1), c(1,2))] <- -length(X)/scale + return(hessian) + } > > ## create data > ## sample size 1000 should give precision 0.1 or better > param <- c(1.5, 2) > set.seed(100) > someData <- rgamma(1000, shape=param[1], scale=param[2]) > start <- c(1,1) > mTol <- .Machine$double.eps^0.25 > > ## estimation with maxLik() / NR > doTests <- function(method="NR") { + suppressWarnings(rLLSum <- maxLik( logLLSum, start=start, method=method, X=someData )) + stdDev <- stdEr(rLLSum) + tol <- 2*max(stdDev) + expect_equal(coef(rLLSum), param, tolerance=tol, + info=paste("coefficient values should be close to the true values", paste(param, collapse=", "))) + # should equal to param, but as N is small, it may be way off + ## + rLL <- suppressWarnings(maxLik( logLL, start = start, method=method, X=someData )) + expect_equal(coef(rLL), coef(rLLSum), tolerance=mTol) + ## + rLLSumGSum <- suppressWarnings(maxLik( logLLSum, grad=d.logLLSum, start = start, method=method, X=someData )) + expect_equal(coef(rLLSumGSum), coef(rLLSum), tolerance=mTol) + rLLG <- suppressWarnings(maxLik( logLL, grad=d.logLL, start = start, method=method, X=someData )) + expect_equal(coef(rLLG), coef(rLLSum), tolerance=mTol) + rLLGH <- suppressWarnings(maxLik( logLL, grad=d.logLL, hess=dd.logLL, start = start, method=method, X=someData )) + expect_equal(coef(rLLGH), coef(rLLSum), tolerance=mTol) + } > > doTests("NR") > doTests("BFGS") > ## maxBHHH: cannot run the same tests > method <- "BHHH" > tryCatch(maxLik( logLLSum, start=start, method=method, X=someData ), + error = function(e) cat(as.character(e)) + # should output error about gradient size + ) Error in checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, : if the gradients (argument 'grad') are not provided by the user, the BHHH method requires that the log-likelihood function (argument 'fn') returns a numeric vector, where each element must be the log-likelihood value corresponding to an individual (independent) observation > rLL <- suppressWarnings(maxLik( logLL, start = start, method=method, X=someData )) > stdDev <- stdEr(rLL) > tol <- 2*max(stdDev) > expect_equal(coef(rLL), param, tolerance=tol, + info=paste("coefficient values should be close to the true values", paste(param, collapse=", "))) > # should equal to param, but as N is small, it may be way off > ## > rLLG <- suppressWarnings(maxLik( logLL, grad=d.logLL, start = start, method=method, X=someData )) > expect_equal(coef(rLLG), coef(rLL), tolerance=mTol) > > ## Do the other basic functions work? > expect_equal(class(logLik(rLL)), "numeric") > expect_equal(class(gradient(rLL)), "numeric") > expect_true(inherits(hessian(rLL), "matrix"), + info="Hessian must inherit from matrix class") > > ## test maxNR with gradient and hessian as attributes > W <- matrix(-c(4,1,2,4), 2, 2) > c <- c(1,2) > start <- c(0,0) > f <- function(x) { + hess <- 2*W + grad <- 2*W %*% (x - c) + val <- t(x - c) %*% W %*% (x - c) + attr(val, "gradient") <- as.vector(grad) + # gradient matrices only work for BHHH-type problems + attr(val, "hessian") <- hess + val + } > res <- maxNR(f, start=start) > expect_equal(coef(res), c, tolerance=mTol) > expect_equal(sqrt(sum(gradient(res)^2)), 0, tolerance=mTol) > expect_equal(maxValue(res), 0, tolerance=mTol) > > proc.time() user system elapsed 0.983 0.589 0.683 maxLik/tests/finalHessian.Rout.save0000644000176200001440000002650512577133556017103 0ustar liggesusers R version 3.1.1 (2014-07-10) -- "Sock it to Me" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: x86_64-redhat-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### Test the 'finalHessian' argument of optimization routines > > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > set.seed( 4 ) > > # log-likelihood function, gradient, and Hessian for 1-parameter case (exponential distribution) > ll1i <- function(theta) { + if(!all(theta > 0)) + return(NA) + log(theta) - theta*t + } > ll1 <- function(theta) sum( log(theta) - theta*t ) > gr1i <- function(theta) 1/theta - t > gr1 <- function(theta) sum( 1/theta - t ) > hs1 <- function(theta) -100/theta^2 > t <- rexp( 100, 2 ) > > ## the same functions for 2-variable case (normal distribution) > ll2 <- function( param ) { + ## log likelihood function + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + N <- length( x ) + llValue <- -0.5 * N * log( 2 * pi ) - N * log( sigma ) - + 0.5 * sum( ( x - mu )^2 / sigma^2 ) + return( llValue ) + } > > ## log likelihood function (individual observations) > ll2i <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + if(!(sigma > 0)) + return(NA) + # to avoid warnings in the output + llValues <- -0.5 * log( 2 * pi ) - log( sigma ) - + 0.5 * ( x - mu )^2 / sigma^2 + return( llValues ) + } > > gr2 <- function( param ) { + ## function to calculate analytical gradients + mu <- param[ 1 ] + sigma <- param[ 2 ] + N <- length( x ) + llGrad <- c( sum( ( x - mu ) / sigma^2 ), + - N / sigma + sum( ( x - mu )^2 / sigma^3 ) ) + return( llGrad ) + } > > ## function to calculate analytical gradients (individual observations) > gr2i <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + llGrads <- cbind( ( x - mu ) / sigma^2, + - 1 / sigma + ( x - mu )^2 / sigma^3 ) + return( llGrads ) + } > > ## function to calculate analytical Hessians > hs2 <- function( param ) { + mu <- param[ 1 ] + sigma <- param[ 2 ] + N <- length( x ) + llHess <- matrix( c( + N * ( - 1 / sigma^2 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + sum( - 2 * ( x - mu ) / sigma^3 ), + N / sigma^2 + sum( - 3 * ( x - mu )^2 / sigma^4 ) ), + nrow = 2, ncol = 2 ) + return( llHess ) + } > x <- rnorm(100, 1, 2) > > > ## NR > # Estimate with only function values (single parameter) > a <- maxLik( ll1i, gr1i, start = 1, method = "NR" ) > summary(a ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -25.05386 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.1159 0.2116 10 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > b <- maxLik( ll1i, gr1i, start = 1, method = "NR", finalHessian="bhhh") > # should issue a warning as BHHH not possible > summary(b ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -25.05386 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.1159 0.2145 9.863 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > c <- maxLik( ll1i, gr1i, start = 1, method = "NR", finalHessian=FALSE) > summary(c) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -25.05386 1 free parameters Estimates: Estimate t value Pr(> t) [1,] 2.116 NA NA -------------------------------------------- > ## (vector parameter) > a <- maxLik( ll2, gr2, start = c(0,1), method = "NR" ) > summary(a ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.8532 0.2031 4.201 2.66e-05 *** [2,] 2.0311 0.1436 14.142 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > b <- maxLik( ll2, gr2, start = c(0,1), method = "NR", finalHessian="bhhh") Warning message: In maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, : For computing the final Hessian by 'BHHH' method, the log-likelihood or gradient must be supplied by observations > # should issue a warning as BHHH not possible > summary(b ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate t value Pr(> t) [1,] 0.8532 NA NA [2,] 2.0311 NA NA -------------------------------------------- > c <- maxLik( ll2, gr2, start = c(0,1), method = "NR", finalHessian=FALSE) > summary(c) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 iterations Return code 1: gradient close to zero Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate t value Pr(> t) [1,] 0.8532 NA NA [2,] 2.0311 NA NA -------------------------------------------- > > ## BFGSR > # Estimate with only function values (single parameter) > a <- maxLik( ll1i, gr1i, start = 1, method = "BFGSR" ) > summary(a ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 26 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -25.05386 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.1159 0.2116 10 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > b <- maxLik( ll1i, gr1i, start = 1, method = "BFGSR", finalHessian="bhhh") > # should issue a warning as BHHH not possible > summary(b ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 26 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -25.05386 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.1159 0.2145 9.863 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > c <- maxLik( ll1i, gr1i, start = 1, method = "BFGSR", finalHessian=FALSE) > summary(c) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 26 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -25.05386 1 free parameters Estimates: Estimate t value Pr(> t) [1,] 2.116 NA NA -------------------------------------------- > # Estimate with only function values (vector parameter) > a <- maxLik( ll2, gr2, start = c(0,1), method = "BFGSR" ) > summary(a ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 22 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.8528 0.2031 4.199 2.68e-05 *** [2,] 2.0309 0.1436 14.144 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > b <- maxLik( ll2, gr2, start = c(0,1), method = "BFGSR", finalHessian="bhhh") Warning message: In maxBFGSRCompute(fn = function (theta, fnOrig, gradOrig = NULL, : For computing the final Hessian by 'BHHH' method, the log-likelihood or gradient must be supplied by observations > # should issue a warning as BHHH not possible > summary(b ) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 22 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate t value Pr(> t) [1,] 0.8528 NA NA [2,] 2.0309 NA NA -------------------------------------------- > c <- maxLik( ll2, gr2, start = c(0,1), method = "BFGSR", finalHessian=FALSE) > summary(c) -------------------------------------------- Maximum Likelihood estimation BFGSR maximization, 22 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate t value Pr(> t) [1,] 0.8528 NA NA [2,] 2.0309 NA NA -------------------------------------------- > > > ### Nelder-Mead > ## Individual observations only > b <- maxLik( ll2i, start = c(0,1), method = "NM", finalHessian="bhhh") > summary(b) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.8530 0.2032 4.199 2.69e-05 *** [2,] 2.0312 0.1670 12.163 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > ## Individual observations, summed gradient > b <- maxLik( ll2i, gr2, start = c(0,1), method = "NM", finalHessian="bhhh") Warning message: In maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "Nelder-Mead", : For computing the final Hessian by 'BHHH' method, the log-likelihood or gradient must be supplied by observations > # should issue a warning as BHHH not selected > # (yes, could do it based on individual likelihood and numeric gradient) > summary(b) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 63 iterations Return code 0: successful convergence Log-Likelihood: -212.7524 2 free parameters Estimates: Estimate t value Pr(> t) [1,] 0.853 NA NA [2,] 2.031 NA NA -------------------------------------------- > > proc.time() user system elapsed 0.689 0.046 0.726 maxLik/tests/BFGSR.Rout.save0000644000176200001440000000631413466434557015341 0ustar liggesusers R version 3.6.0 (2019-04-26) -- "Planting of a Tree" 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. 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. > ### BFGSR-related tests > > ## 1. Test maximization algorithm for convex regions > ## > ## Optimize quadratic form t(D) %*% W %*% D with p.d. weight matrix > ## (ie unbounded problems). > ## All solutions should go to large values with a message about successful convergence > set.seed(0) > options(digits=4) > quadForm <- function(D) { + C <- seq(1, N) + return( - t(D - C) %*% W %*% ( D - C) ) + } > N <- 3 > # 3-dimensional case > ## a) test quadratic function t(D) %*% D > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > W <- diag(N) > D <- rep(1/N, N) > res <- maxBFGSR(quadForm, start=D) > all.equal(coef(res), 1:3, tolerance=1e-4) [1] TRUE > all.equal(gradient(res), rep(0,3), tolerance=1e-3) [1] TRUE > all.equal(nIter(res) < 100, TRUE) [1] TRUE > all.equal(returnCode(res) < 4, TRUE) [1] TRUE > > ## Next, optimize hat function in non-concave region. Does not work well. > hat <- function(param) { + ## Hat function. Hessian negative definite if sqrt(x^2 + y^2) < 0.5 + x <- param[1] + y <- param[2] + exp(-(x-2)^2 - (y-2)^2) + } > > hatNC <- maxBFGSR(hat, start=c(1,1), tol=0, reltol=0) > all.equal(coef(hatNC), rep(2,2), tolerance=1e-4) [1] TRUE > all.equal(gradient(hatNC), rep(0,2), tolerance=1e-3) [1] TRUE > all.equal(nIter(hatNC) < 100, TRUE) [1] TRUE > all.equal(returnCode(hatNC) < 4, TRUE) [1] TRUE > > ## Test BFGSR with fixed parameters and equality constraints > ## Optimize 3D hat with one parameter fixed (== 2D hat). > ## Add an equality constraint on that > hat3 <- function(param) { + ## Hat function. Hessian negative definite if sqrt((x-2)^2 + (y-2)^2) < 0.5 + x <- param[1] + y <- param[2] + z <- param[3] + exp(-(x-2)^2-(y-2)^2-(z-2)^2) + } > sv <- c(x=1,y=1,z=1) > ## constraints: x + y + z = 8 > A <- matrix(c(1,1,1), 1, 3) > B <- -8 > constraints <- list(eqA=A, eqB=B) > hat3CF <- maxBFGSR(hat3, start=sv, constraints=constraints, fixed=3) > all.equal(coef(hat3CF), c(x=3.5, y=3.5, z=1), tolerance=1e-4) [1] TRUE > all.equal(nIter(hat3CF) < 100, TRUE) [1] TRUE > all.equal(returnCode(hat3CF) < 4, TRUE) [1] TRUE > all.equal(sum(coef(hat3CF)), 8, tolerance=1e-4) [1] TRUE > > proc.time() user system elapsed 0.562 0.560 0.338 maxLik/tests/basicTest.R0000644000176200001440000001011213603262305014700 0ustar liggesusers### general optimization tests for the functions of various forms ### test for: ### 1. numeric gradient, Hessian ### 2. analytic gradient, numeric Hessian ### 3. analytic gradient, Hessian ### ### a) maxLik(, method="NR") ### c) maxLik(, method="BFGS") ### b) maxLik(, method="BHHH") ### ### i) maxNR() ### ii) maxBFGS() library(maxLik) library(testthat) # log-likelihood function(s) logLL <- function(x, X) # per observation for maxLik dgamma(x = X, shape = x[1], scale = x[2], log = TRUE) logLLSum <- function(x, X) sum(logLL(x, X)) # gradient of log-likelihood function d.logLL <- function(x, X){ # analytic 1. derivatives shape <- x[1] scale <- x[2] cbind(shape= log(X) - log(scale) - psigamma(shape, 0), scale= (X/scale - shape)/scale ) } d.logLLSum <- function(x, X) { ## analytic 1. derivatives, summed colSums(d.logLL(x, X)) } ## Hessian of log-likelihood function dd.logLL <- function(x, X){ # analytic 2. derivatives shape <- x[1] scale <- x[2] hessian <- matrix(0, 2, 2) hessian[1,1] <- -psigamma(shape, 1)*length(X) hessian[2,2] <- (shape*length(X) - 2*sum(X)/scale)/scale^2 hessian[cbind(c(2,1), c(1,2))] <- -length(X)/scale return(hessian) } ## create data ## sample size 1000 should give precision 0.1 or better param <- c(1.5, 2) set.seed(100) someData <- rgamma(1000, shape=param[1], scale=param[2]) start <- c(1,1) mTol <- .Machine$double.eps^0.25 ## estimation with maxLik() / NR doTests <- function(method="NR") { suppressWarnings(rLLSum <- maxLik( logLLSum, start=start, method=method, X=someData )) stdDev <- stdEr(rLLSum) tol <- 2*max(stdDev) expect_equal(coef(rLLSum), param, tolerance=tol, info=paste("coefficient values should be close to the true values", paste(param, collapse=", "))) # should equal to param, but as N is small, it may be way off ## rLL <- suppressWarnings(maxLik( logLL, start = start, method=method, X=someData )) expect_equal(coef(rLL), coef(rLLSum), tolerance=mTol) ## rLLSumGSum <- suppressWarnings(maxLik( logLLSum, grad=d.logLLSum, start = start, method=method, X=someData )) expect_equal(coef(rLLSumGSum), coef(rLLSum), tolerance=mTol) rLLG <- suppressWarnings(maxLik( logLL, grad=d.logLL, start = start, method=method, X=someData )) expect_equal(coef(rLLG), coef(rLLSum), tolerance=mTol) rLLGH <- suppressWarnings(maxLik( logLL, grad=d.logLL, hess=dd.logLL, start = start, method=method, X=someData )) expect_equal(coef(rLLGH), coef(rLLSum), tolerance=mTol) } doTests("NR") doTests("BFGS") ## maxBHHH: cannot run the same tests method <- "BHHH" tryCatch(maxLik( logLLSum, start=start, method=method, X=someData ), error = function(e) cat(as.character(e)) # should output error about gradient size ) rLL <- suppressWarnings(maxLik( logLL, start = start, method=method, X=someData )) stdDev <- stdEr(rLL) tol <- 2*max(stdDev) expect_equal(coef(rLL), param, tolerance=tol, info=paste("coefficient values should be close to the true values", paste(param, collapse=", "))) # should equal to param, but as N is small, it may be way off ## rLLG <- suppressWarnings(maxLik( logLL, grad=d.logLL, start = start, method=method, X=someData )) expect_equal(coef(rLLG), coef(rLL), tolerance=mTol) ## Do the other basic functions work? expect_equal(class(logLik(rLL)), "numeric") expect_equal(class(gradient(rLL)), "numeric") expect_true(inherits(hessian(rLL), "matrix"), info="Hessian must inherit from matrix class") ## test maxNR with gradient and hessian as attributes W <- matrix(-c(4,1,2,4), 2, 2) c <- c(1,2) start <- c(0,0) f <- function(x) { hess <- 2*W grad <- 2*W %*% (x - c) val <- t(x - c) %*% W %*% (x - c) attr(val, "gradient") <- as.vector(grad) # gradient matrices only work for BHHH-type problems attr(val, "hessian") <- hess val } res <- maxNR(f, start=start) expect_equal(coef(res), c, tolerance=mTol) expect_equal(sqrt(sum(gradient(res)^2)), 0, tolerance=mTol) expect_equal(maxValue(res), 0, tolerance=mTol) maxLik/tests/constraints.Rout.save0000644000176200001440000004257513464453351017045 0ustar liggesusers R version 3.5.3 (2019-03-11) -- "Great Truth" 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. 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. > ### Various tests for constrained optimization > ### > options(digits=4) > > ### -------------------- Normal mixture likelihood, no additional parameters -------------------- > ### param = c(rho, mean1, mean2) > ### > ### X = N(mean1) w/Pr rho > ### X = N(mean2) w/Pr 1-rho > ### > logLikMix <- function(param) { + ## a single likelihood value + rho <- param[1] + if(rho < 0 || rho > 1) + return(NA) + mu1 <- param[2] + mu2 <- param[3] + ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) + ll <- sum(ll) + ll + } > > gradLikMix <- function(param) { + rho <- param[1] + if(rho < 0 || rho > 1) + return(NA) + mu1 <- param[2] + mu2 <- param[3] + f1 <- dnorm(x - mu1) + f2 <- dnorm(x - mu2) + L <- rho*f1 + (1 - rho)*f2 + g <- matrix(0, length(x), 3) + g[,1] <- (f1 - f2)/L + g[,2] <- rho*(x - mu1)*f1/L + g[,3] <- (1 - rho)*(x - mu2)*f2/L + colSums(g) + g + } > > hessLikMix <- function(param) { + rho <- param[1] + if(rho < 0 || rho > 1) + return(NA) + mu1 <- param[2] + mu2 <- param[3] + f1 <- dnorm(x - mu1) + f2 <- dnorm(x - mu2) + L <- rho*f1 + (1 - rho)*f2 + dldrho <- (f1 - f2)/L + dldmu1 <- rho*(x - mu1)*f1/L + dldmu2 <- (1 - rho)*(x - mu2)*f2/L + h <- matrix(0, 3, 3) + h[1,1] <- -sum(dldrho*(f1 - f2)/L) + h[2,1] <- h[1,2] <- sum((x - mu1)*f1/L - dldmu1*dldrho) + h[3,1] <- h[1,3] <- sum(-(x - mu2)*f2/L - dldmu2*dldrho) + h[2,2] <- sum(rho*(-f1 + (x - mu1)^2*f1)/L - dldmu1^2) + h[2,3] <- h[3,2] <- -sum(dldmu1*dldmu2) + h[3,3] <- sum((1 - rho)*(-f2 + (x - mu2)^2*f2)/L - dldmu2^2) + h + } > > logLikMixInd <- function(param) { + ## individual obs-wise likelihood values + rho <- param[1] + if(rho < 0 || rho > 1) + return(NA) + mu1 <- param[2] + mu2 <- param[3] + ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) + ll <- sum(ll) + ll + } > > gradLikMixInd <- function(param) { + rho <- param[1] + if(rho < 0 || rho > 1) + return(NA) + mu1 <- param[2] + mu2 <- param[3] + f1 <- dnorm(x - mu1) + f2 <- dnorm(x - mu2) + L <- rho*f1 + (1 - rho)*f2 + g <- matrix(0, length(x), 3) + g[,1] <- (f1 - f2)/L + g[,2] <- rho*(x - mu1)*f1/L + g[,3] <- (1 - rho)*(x - mu2)*f2/L + colSums(g) + g + } > > ### -------------------------- > library(maxLik) Loading required package: miscTools Please cite the 'maxLik' package as: Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1. If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site: https://r-forge.r-project.org/projects/maxlik/ > ## mixed normal > set.seed(1) > N <- 100 > x <- c(rnorm(N, mean=-1), rnorm(N, mean=1)) > > ## ---------- INEQUALITY CONSTRAINTS ----------- > ## First test inequality constraints, numeric/analytical gradients > ## Inequality constraints: rho < 0.5, mu1 < -0.1, mu2 > 0.1 > A <- matrix(c(-1, 0, 0, + 0, -1, 0, + 0, 0, 1), 3, 3, byrow=TRUE) > B <- c(0.5, 0.1, 0.1) > start <- c(0.4, 0, 0.9) > ineqCon <- list(ineqA=A, ineqB=B) > ## analytic gradient > cat("Inequality constraints, analytic gradient & Hessian\n") Inequality constraints, analytic gradient & Hessian > a <- maxLik(logLikMix, grad=gradLikMix, hess=hessLikMix, + start=start, + constraints=ineqCon) > all.equal(coef(a), c(0.5, -1, 1), tolerance=0.1) [1] "Mean relative difference: 0.1624" > # TRUE: relative tolerance 0.045 > ## No analytic gradient > cat("Inequality constraints, numeric gradient & Hessian\n") Inequality constraints, numeric gradient & Hessian > a <- maxLik(logLikMix, + start=start, + constraints=ineqCon) > all.equal(coef(a), c(0.5, -1, 1), tolerance=0.1) [1] "Mean relative difference: 0.2547" > # should be close to the true values, but N is too small > ## NR method with inequality constraints > try( maxLik(logLikMix, start = start, constraints = ineqCon, method = "NR" ) ) Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : Inequality constraints not implemented for maxNR > # Error in maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, : > # Inequality constraints not implemented for maxNR > > ## BHHH method with inequality constraints > try( maxLik(logLikMix, start = start, constraints = ineqCon, method = "BHHH" ) ) Error in maxNR(fn = fn, grad = grad, hess = hess, start = start, finalHessian = finalHessian, : Inequality constraints not implemented for maxNR > # Error in maxNR(fn = fn, grad = grad, hess = hess, start = start, finalHessian = finalHessian, : > # Inequality constraints not implemented for maxNR > > ## ---------- EQUALITY CONSTRAINTS ----------------- > cat("Test for equality constraints mu1 + 2*mu2 = 0\n") Test for equality constraints mu1 + 2*mu2 = 0 > A <- matrix(c(0, 1, 2), 1, 3) > B <- 0 > eqCon <- list( eqA = A, eqB = B ) > ## default, numeric gradient > mlEq <- maxLik(logLikMix, start = start, constraints = eqCon, tol=0) > # only rely on gradient stopping condition > all.equal(coef(mlEq), c(0.33, -1.45, 0.72), tolerance=0.01, scale=1) [1] "Mean absolute difference: 0.1777" > ## default, individual likelihood > mlEqInd <- maxLik(logLikMixInd, start = start, constraints = eqCon, tol=0) > # only rely on gradient stopping condition > all.equal(coef(mlEq), coef(mlEqInd), tol=1e-4) [1] TRUE > ## default, analytic gradient > mlEqG <- maxLik(logLikMix, grad=gradLikMix, + start = start, constraints = eqCon ) > all.equal(coef(mlEq), coef(mlEqG), tolerance=1e-4) [1] TRUE > ## default, analytic gradient, individual likelihood > mlEqGInd <- maxLik(logLikMixInd, grad=gradLikMixInd, + start = start, constraints = eqCon ) > all.equal(coef(mlEqG), coef(mlEqGInd), tolerance=1e-4) [1] TRUE > ## default, analytic Hessian > mlEqH <- maxLik(logLikMix, grad=gradLikMix, hess=hessLikMix, + start=start, + constraints=eqCon) > all.equal(coef(mlEqG), coef(mlEqH), tolerance=1e-4) [1] TRUE > > > ## BFGS, numeric gradient > eqBFGS <- maxLik(logLikMix, + start=start, method="bfgs", + constraints=eqCon, + SUMTRho0=1) > all.equal(coef(eqBFGS), c(0.33, -1.45, 0.72), tolerance=0.01, scale=1) [1] "Mean absolute difference: 0.1777" > > ## BHHH, analytic gradient (numeric does not converge?) > eqBHHH <- maxLik(logLikMix, gradLikMix, + start=start, method="bhhh", + constraints=eqCon, + SUMTRho0=1) > all.equal(coef(eqBFGS), coef(eqBHHH), tol=1e-4) [1] "Mean relative difference: 0.003536" > > > ### ------------------ Now test additional parameters for the function ---- > ### similar mixture as above but rho is give as an extra parameter > ### > logLikMix2 <- function(param, rho) { + mu1 <- param[1] + mu2 <- param[2] + ll <- log(rho*dnorm(x - mu1) + (1 - rho)*dnorm(x - mu2)) + # ll <- sum(ll) + ll + } > > gradLikMix2 <- function(param, rho) { + mu1 <- param[1] + mu2 <- param[2] + f1 <- dnorm(x - mu1) + f2 <- dnorm(x - mu2) + L <- rho*f1 + (1 - rho)*f2 + g <- matrix(0, length(x), 2) + g[,1] <- rho*(x - mu1)*f1/L + g[,2] <- (1 - rho)*(x - mu2)*f2/L + # colSums(g) + g + } > > hessLikMix2 <- function(param, rho) { + mu1 <- param[1] + mu2 <- param[2] + f1 <- dnorm(x - mu1) + f2 <- dnorm(x - mu2) + L <- rho*f1 + (1 - rho)*f2 + dldrho <- (f1 - f2)/L + dldmu1 <- rho*(x - mu1)*f1/L + dldmu2 <- (1 - rho)*(x - mu2)*f2/L + h <- matrix(0, 2, 2) + h[1,1] <- sum(rho*(-f1 + (x - mu1)^2*f1)/L - dldmu1^2) + h[1,2] <- h[2,1] <- -sum(dldmu1*dldmu2) + h[2,2] <- sum((1 - rho)*(-f2 + (x - mu2)^2*f2)/L - dldmu2^2) + h + } > > ## ---------- Equality constraints & extra parameters ------------ > A <- matrix(c(1, 2), 1, 2) > B <- 0 > start <- c(0, 1) > ## We run only a few iterations as we want to test correct handling > ## of parameters, not the final value. We also avoid any > ## debug information > iterlim <- 3 > cat("Test for extra parameters for the function\n") Test for extra parameters for the function > ## NR, numeric gradient > cat("Newton-Raphson, numeric gradient\n") Newton-Raphson, numeric gradient > a <- maxLik(logLikMix2, + start=start, method="nr", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3619" > ## NR, numeric hessian > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="nr", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3619" > ## nr, analytic hessian > a <- maxLik(logLikMix2, gradLikMix2, hessLikMix2, + start=start, method="nr", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3619" > ## BHHH > cat("BHHH, analytic gradient, numeric Hessian\n") BHHH, analytic gradient, numeric Hessian > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="bhhh", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3512" > ## BHHH, analytic > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="bhhh", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3512" > ## bfgs, no analytic gradient > a <- maxLik(logLikMix2, + start=start, method="bfgs", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3381" > ## bfgs, analytic gradient > a <- maxLik(logLikMix2, + start=start, method="bfgs", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3381" > ## SANN, analytic gradient > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="SANN", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) Warning message: In (function (fn, grad = NULL, hess = NULL, start, maxRoutine, constraints, : problem in imposing equality constraints: the constraints are not satisfied (barrier value = 0.00173566161904632). Try setting 'SUMTTol' to 0 > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.2285" > ## NM, numeric > a <- maxLik(logLikMix2, + start=start, method="nm", + constraints=list(eqA=A, eqB=B), + iterlim=100, + # use more iters for NM + SUMTRho0=1, rho=0.5) > all.equal(coef(a), c(-1.36, 0.68), tol=0.01) [1] "Mean relative difference: 0.3621" > > ## -------------------- NR, multiple constraints -------------------- > f <- function(theta) exp(-theta %*% theta) > # test quadratic function > ## constraints: > ## theta1 + theta3 = 1 > ## theta1 + theta2 = 1 > A <- matrix(c(1, 0, 1, + 1, 1, 0), 2, 3, byrow=TRUE) > B <- c(-1, -1) > cat("NR, multiple constraints\n") NR, multiple constraints > a <- maxNR(f, start=c(1,1.1,2), constraints=list(eqA=A, eqB=B)) > theta <- coef(a) > all.equal(c(theta[1] + theta[3], theta[1] + theta[2]), c(1,1), tolerance=1e-4) [1] TRUE > ## Error handling for equality constraints > A <- matrix(c(1, 1), 1, 2) > B <- -1 > cat("Error handling: ncol(A) != lengths(start)\n") Error handling: ncol(A) != lengths(start) > try(a <- maxNR(f, start=c(1, 2, 3), constraints=list(eqA=A, eqB=B))) Error in sumt(fn = function (theta) : Equality constraint matrix A must have the same number of columns as the parameter length (currently 2 and 3) > # ncol(A) != length(start) > A <- matrix(c(1, 1), 1, 2) > B <- c(-1, 2) > try(a <- maxNR(f, start=c(1, 2), constraints=list(eqA=A, eqB=B))) Error in sumt(fn = function (theta) : Equality constraint matrix A must have the same number of rows as the matrix B (currently 1 and 2) > # nrow(A) != nrow(B) > ## > ## -------------- inequality constraints & extra paramters ---------------- > ## > ## mu1 < 1 > ## mu2 > -1 > A <- matrix(c(-1, 0, + 0, 1), 2,2, byrow=TRUE) > B <- c(1,1) > start <- c(0.8, 0.9) > ## > inEGrad <- maxLik(logLikMix2, gradLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A, ineqB=B), + rho=0.5) > all.equal(coef(inEGrad), c(-0.98, 1.12), tol=0.01) [1] "Mean relative difference: 0.2716" > ## > inE <- maxLik(logLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A, ineqB=B), + rho=0.5) > all.equal(coef(inEGrad), coef(inE), tol=1e-4) [1] TRUE > ## > inENM <- maxLik(logLikMix2, gradLikMix2, + start=start, method="nm", + constraints=list(ineqA=A, ineqB=B), + rho=0.5) > all.equal(coef(inEGrad), coef(inENM), tol=1e-3) [1] TRUE > # this is further off than gradient-based methods > ## ---------- test vector B for inequality -------------- > ## mu1 < 1 > ## mu2 > 2 > A <- matrix(c(-1, 0, + 0, 1), 2,2, byrow=TRUE) > B1 <- c(1,-2) > a <- maxLik(logLikMix2, gradLikMix2, + start=c(0.5, 2.5), method="bfgs", + constraints=list(ineqA=A, ineqB=B1), + rho=0.5) > theta <- coef(a) > all.equal(c(theta[1] < 1, theta[2] > 2), c(TRUE, TRUE)) [1] TRUE > # components should be larger than > # (-1, -2) > > ## > ## ---- ERROR HANDLING: insert wrong A and B forms ---- > ## > A2 <- c(-1, 0, 0, 1) > try(maxLik(logLikMix2, gradLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A2, ineqB=B), + print.level=1, rho=0.5) + ) Error in maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : Inequality constraint A must be a matrix Current dimension > # should explain that matrix needed > A2 <- matrix(c(-1, 0, 0, 1), 1, 4) > try(maxLik(logLikMix2, gradLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A2, ineqB=B), + print.level=1, rho=0.5) + ) Error in maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : Inequality constraint A must have the same number of columns as length of the parameter. Currently 4 and 2. > # should explain that wrong matrix > # dimension > B2 <- 1:3 > try(maxLik(logLikMix2, gradLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A, ineqB=B2), + print.level=1, rho=0.5) + ) Error in maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : Inequality constraints A and B suggest different number of constraints: 2 and 3 > # A & B do not match > cat("A & B do not match\n") A & B do not match > B2 <- matrix(1,2,2) > try(maxLik(logLikMix2, gradLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A, ineqB=B2), + print.level=1, rho=0.5) + ) Error in maxOptim(fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", : Inequality constraint B must be a vector (or Nx1 matrix). Currently 2 columns > # B must be a vector > > ## ---- fixed parameters with constrained optimization ----- > ## Thanks to Bob Loos for finding this error. > ## Optimize 3D hat with one parameter fixed (== 2D hat). > ## Add an equality constraint on that > cat("Constraints + fixed parameters\n") Constraints + fixed parameters > hat3 <- function(param) { + ## Hat function. Hessian negative definite if sqrt(x^2 + y^2) < 0.5 + x <- param[1] + y <- param[2] + z <- param[3] + exp(-x^2-y^2-z^2) + } > sv <- c(1,1,1) > ## constraints: x + y + z >= 2.5 > A <- matrix(c(x=1,y=1,z=1), 1, 3) > B <- -2.5 > constraints <- list(ineqA=A, ineqB=B) > res <- maxBFGS(hat3, start=sv, constraints=constraints, fixed=3, + iterlim=3) > all.equal(coef(res), c(0.770, 0.770, 1), tol=0.01) [1] TRUE > > proc.time() user system elapsed 1.676 0.329 1.571 maxLik/tests/finalHessian.R0000644000176200001440000000772011641575577015420 0ustar liggesusers### Test the 'finalHessian' argument of optimization routines library(maxLik) set.seed( 4 ) # log-likelihood function, gradient, and Hessian for 1-parameter case (exponential distribution) ll1i <- function(theta) { if(!all(theta > 0)) return(NA) log(theta) - theta*t } ll1 <- function(theta) sum( log(theta) - theta*t ) gr1i <- function(theta) 1/theta - t gr1 <- function(theta) sum( 1/theta - t ) hs1 <- function(theta) -100/theta^2 t <- rexp( 100, 2 ) ## the same functions for 2-variable case (normal distribution) ll2 <- function( param ) { ## log likelihood function mu <- param[ 1 ] sigma <- param[ 2 ] if(!(sigma > 0)) return(NA) # to avoid warnings in the output N <- length( x ) llValue <- -0.5 * N * log( 2 * pi ) - N * log( sigma ) - 0.5 * sum( ( x - mu )^2 / sigma^2 ) return( llValue ) } ## log likelihood function (individual observations) ll2i <- function( param ) { mu <- param[ 1 ] sigma <- param[ 2 ] if(!(sigma > 0)) return(NA) # to avoid warnings in the output llValues <- -0.5 * log( 2 * pi ) - log( sigma ) - 0.5 * ( x - mu )^2 / sigma^2 return( llValues ) } gr2 <- function( param ) { ## function to calculate analytical gradients mu <- param[ 1 ] sigma <- param[ 2 ] N <- length( x ) llGrad <- c( sum( ( x - mu ) / sigma^2 ), - N / sigma + sum( ( x - mu )^2 / sigma^3 ) ) return( llGrad ) } ## function to calculate analytical gradients (individual observations) gr2i <- function( param ) { mu <- param[ 1 ] sigma <- param[ 2 ] llGrads <- cbind( ( x - mu ) / sigma^2, - 1 / sigma + ( x - mu )^2 / sigma^3 ) return( llGrads ) } ## function to calculate analytical Hessians hs2 <- function( param ) { mu <- param[ 1 ] sigma <- param[ 2 ] N <- length( x ) llHess <- matrix( c( N * ( - 1 / sigma^2 ), sum( - 2 * ( x - mu ) / sigma^3 ), sum( - 2 * ( x - mu ) / sigma^3 ), N / sigma^2 + sum( - 3 * ( x - mu )^2 / sigma^4 ) ), nrow = 2, ncol = 2 ) return( llHess ) } x <- rnorm(100, 1, 2) ## NR # Estimate with only function values (single parameter) a <- maxLik( ll1i, gr1i, start = 1, method = "NR" ) summary(a ) b <- maxLik( ll1i, gr1i, start = 1, method = "NR", finalHessian="bhhh") # should issue a warning as BHHH not possible summary(b ) c <- maxLik( ll1i, gr1i, start = 1, method = "NR", finalHessian=FALSE) summary(c) ## (vector parameter) a <- maxLik( ll2, gr2, start = c(0,1), method = "NR" ) summary(a ) b <- maxLik( ll2, gr2, start = c(0,1), method = "NR", finalHessian="bhhh") # should issue a warning as BHHH not possible summary(b ) c <- maxLik( ll2, gr2, start = c(0,1), method = "NR", finalHessian=FALSE) summary(c) ## BFGSR # Estimate with only function values (single parameter) a <- maxLik( ll1i, gr1i, start = 1, method = "BFGSR" ) summary(a ) b <- maxLik( ll1i, gr1i, start = 1, method = "BFGSR", finalHessian="bhhh") # should issue a warning as BHHH not possible summary(b ) c <- maxLik( ll1i, gr1i, start = 1, method = "BFGSR", finalHessian=FALSE) summary(c) # Estimate with only function values (vector parameter) a <- maxLik( ll2, gr2, start = c(0,1), method = "BFGSR" ) summary(a ) b <- maxLik( ll2, gr2, start = c(0,1), method = "BFGSR", finalHessian="bhhh") # should issue a warning as BHHH not possible summary(b ) c <- maxLik( ll2, gr2, start = c(0,1), method = "BFGSR", finalHessian=FALSE) summary(c) ### Nelder-Mead ## Individual observations only b <- maxLik( ll2i, start = c(0,1), method = "NM", finalHessian="bhhh") summary(b) ## Individual observations, summed gradient b <- maxLik( ll2i, gr2, start = c(0,1), method = "NM", finalHessian="bhhh") # should issue a warning as BHHH not selected # (yes, could do it based on individual likelihood and numeric gradient) summary(b) maxLik/NEWS0000644000176200001440000002113113470166502012200 0ustar liggesusersTHIS IS THE CHANGELOG OF THE "maxLik" PACKAGE Please note that only the most significant changes are reported here. A full ChangeLog is available in the log messages of the SVN repository on R-Forge. CHANGES IN VERSION 1.3-8 (2019-05-18) * CHANGES IN VERSION 1.3-6 (2019-05-18) * 'maxim' objects now support 'maxValue' and 'gradient' methods. * tests cleaned and give fewer notes on check CHANGES IN VERSION 1.3-4 (2015-11-08) * If Hessian is not negative definite in maxNRCompute, the program now attempts to correct this repeatedly, but not infinite number of times. If Marquardt selected, it uses Marquardt lambda and it's update method. * Fixed an issue where summary.maxLik did not use 'eigentol' option for displaying standard errors CHANGES IN VERSION 1.3-2 (2015-10-28) * Corrected a bug that did not permit maxLik to pass additional arguments to the likelihood function CHANGES IN VERSION 1.3-0 (2015-10-24) * maxNR & friends now support argument 'qac' (quadratic approximation correction) option that allows to choose the behavior if the next guess performs worse than the previous one. This includes the original step halving while keeping direction, and now also Marquardt's (1963) shift toward the steepest gradient. * all max** functions now take control options in the form as 'control=list(...)', analogously as 'optim'. The former method of directly supplying options is preserved for compatibility reasons. * sumt, and stdEr method for 'maxLik' are now in namespace * the preferred way to specify the amount of debugging information is now 'printLevel', not 'print.level'. CHANGES IN VERSION 1.2-4 (2014-12-31) * Equality constraints (SUMT) checks conformity of the matrices * coef.maxim() is now exported * added argument "digits" to print.summary.maxLik() * added argument "digits" to condiNumber.default() * further arguments to condiNumber.maxLik() are now passed to condiNumber.default() rather than to hessian() CHANGES IN VERSION 1.2-0 (2013-10-22) * Inequality constraints now support multiple constraints (B may be a vector). * Fixed a bug in documentation, inequality constraint requires A %*% theta + B > 0, not >= 0 as stated earlier. * function sumKeepAttr() is imported from the miscTools package now (before maxLik() could not be used by another package when this package imported (and not depended on) the maxLik package) (bug reported and solution provided by Martin Becker) CHANGES IN VERSION 1.1-8 (2013-09-17) * fixed bug that could occur in the Newton-Raphson algorithm if the log-likelihood function returns a vector with observation-specific values or if there are NAs in the function values, gradients, or Hessian CHANGES IN VERSION 1.1-4 (2013-09-16) * the package code is byte-compiled * if the log-likelihood function contains NA, the gradient is not calculated; if components of the gradient contain NA, the Hessian is not calculated * slightly improved documentation * improved warning messages and error messages when doing constrained optimisation * added citation information * added start-up message CHANGES IN VERSION 1.1-2 (2012-03-04) * BHHH only considers free parameters when analysing the size of gradient * numericGradient and numericHessian check for the length of vector function CHANGES IN VERSION 1.1-0 (2012-01-...) * Conjugate-gradient (CG) optimization method included. * it is guaranteed now that the variance covariance matrix returned by the vcov() method is always symmetric. * summary.maxLik is guaranteed to use maxLik specific methods, even if corresponding methods for derived classes have higher priority. CHANGES IN VERSION 1.0-2 (2011-10-16) This is mainly bugfix release. * maxBFGSR works with fixed parameters. * maxBFGS and other optim-based routines work with both fixed parameters and inequality constraints. * constrOptim2 removed from API. Names of it's formal arguments are changed. CHANGES IN VERSION 1.0-0 (2010-10-15) * moved the generic function stdEr() including a default method and a method for objects of class "lm" to the "miscTools" package (hence, this package now depends on the version 0.6-8 of the "miscTools" package that includes stdEr() * if argument print.level is 0 (the default) and some parameters are automatically fixed during the estimation, because the returned log-likelihood value has attributes "constPar" and "newVal", the adjusted "starting values" are no longer printed. CHANGES IN VERSION 0.8-0 * fixed bug that occured in maxBFGS(), mxNM(), and maxSANN if the model had only one parameter and the function specified by argument "grad" returned a vector with the analytical gradients at each observation * maxNR() now performs correctly with argument "iterlim" set to 0 * maxNR, maxBHHH(), maxBFGS(), maxNM(), and maxSANN() now use attributes "gradient" and "hessian" of the object returned by the log-likelihood function; if supplied, these are used instead of arguments "grad" and "hess" * added function maxBFGSR() that implements the BFGS algorithm (in R); this function was originally developed by Yves Croissant and placed in the "mlogit" package * maxNR() now has an argument "bhhhHessian" (defaults to FALSE): if this argument is TRUE, the Hessian is approximated by the BHHH method (using information equality), i.e. the BHHH optimization algorithm is used * maxLik() now has an argument 'finalHessian'; if it is TRUE, the final Hessian is returned; if it is the character string "BHHH", the BHHH approximation of the Hessian matrix (using information equality) with attribute "type" set to "BHHH" is returned * maxNR(), maxBHHH(), maxBFGS(), maxNM(), and maxSANN() now additionally return a component "gradientObs" that is the matrix of gradients evaluated at each observation if argument "grad" returns a matrix or argument "grad" is not specified and argument "fn" returns a vector * the definitions of the generic functions nObs() and nParam() have been moved to the "miscTools" package * added methods bread() and estfun() for objects of class "maxLik" (see documentation of the generic functions bread() and estfun() defined in package "sandwich") * replaced argument "activePar" of numericGradient(), numericHessian(), and numericNHessian() by argument "fixed" to be consistent with maxLik(), maxNR(), and the other maxXXX() functions * maxNR(), maxBHHH(), maxBFGSYC(), maxBFGS(), maxNM(), maxSANN(), and summary.maxLik() now return component "fixed" instead of component "activePar" CHANGES IN VERSION 0.7-2 * corrected negative definiteness correction of Hessian in maxNR() which led to infinite loops * changed stopping condition in sumt(): instead of checking whether estimates are stimilar, we check for penalty being low now CHANGES IN VERSION 0.7-0 * Holding parameters fixed in maxNR() (and hence, also in maxBHHH()) should now be done by the new (optional) argument "fixed", because it is convenient to use than the "old" argument "activePar" in many situations. However, the "old" argument "activePar" is kept for backward-compatibility. * added (optional) argument "fixed" to functions maxBFGS(), maxNM(), and maxSANN(), which can be used for holding parameters fixed at their starting values * added function constrOptim2(), which is a modified copy of constrOptim() from the "stats" package, but which includes a bug fix * added optional argument "cand" to function maxSANN(), which can be used to specify a function for generating a new candidate point (passed to argument "gr" of optim()) * added argument "random.seed" to maxSANN() to ensure replicability * several mainly smaller improvements in ML estimations with linear equality and inequality constraints (via sumt() and constrOptim2(), respectively) * several internal changes that make the code easier to maintain CHANGES IN VERSION 0.6-0 * maxLik() can perform maximum likelihood estimations under linear equality and inequality constraints on the parameters now (see documentation of the new argument "constraints"). Please note that estimations under constraints are experimental and have not been thoroughly tested yet. * a new method "stdEr" to extract standard errors of the estimates has been introduced * added a "coef" method for objects of class "summary.maxLik" that extracts the matrix of the estimates, standard errors, t-values, and P-values * some minor bugs have been fixed * we did some general polishing of the returned object and under the hood CHANGES IN VERSION 0.5-12 AND BEFORE * please take a look at the log messages of the SVN repository on R-Forge maxLik/R/0000755000176200001440000000000013603275534011710 5ustar liggesusersmaxLik/R/logLikAttr.R0000644000176200001440000001450713470114640014106 0ustar liggesuserslogLikAttr <- function(theta, fnOrig, gradOrig=NULL, hessOrig=NULL, fixed, sumObs = FALSE, returnHessian = TRUE, ...) { ## fixed: logical, which parameters to keep fixed ## ## this function returns the log-likelihood value with gradient and Hessian as ## attributes. If the log-likelihood function provided by the user does not add ## these attributes, this functions uses the functions provided by the user ## as arguments "grad" and "hess" or (if they are not provided) uses the ## finite-difference method to obtain the gradient and Hessian # large initial indentation to be able to diff to previous version # that was defined in maxNR() / maxNR.R. ## number of parameters nParam <- length( theta ) ## value of log-likelihood function f <- fnOrig(theta, ...) ## if there are NA-s in the function value, do not ## compute gradient and Hessian if(any(is.na(f))) { attr(f, "gradient") <- NA attr(f, "hessian") <- NA return(f) } ## gradient of log-likelihood function gr <- attr( f, "gradient" ) if( is.null( gr ) ) { if( !is.null( gradOrig ) ) { gr <- gradOrig(theta, ...) } else { gr <- numericGradient(f = fnOrig, t0 = theta, fixed=fixed, ...) } } ## if there are NA-s in active gradient, do not compute Hessian if(is.matrix(gr)) { if(ncol(gr) != length(theta)) { stop(paste0("if gradient is a matrix, it must have length(parameter) colums (currently ", length(theta), "), not ", ncol(gr))) } activeGr <- gr[,!fixed] } else { activeGr <- gr[!fixed] } if(any(is.na(activeGr))) { attr(f, "gradient") <- gr attr(f, "hessian") <- NA return(f) } # if gradients are observation-specific, they must be stored in a matrix if(observationGradient(gr, length(theta))) { gr <- as.matrix(gr) } ## Set gradients of fixed parameters to NA so that they are always NA ## (no matter if they are analytical or finite-difference gradients) if( is.null( dim( gr ) ) ) { gr[ fixed ] <- NA } else { gr[ , fixed ] <- NA } ## Hessian of log-likelihood function if( isTRUE( returnHessian ) ) { h <- attr( f, "hessian" ) if( is.null( h ) ) { if(!is.null(hessOrig)) { h <- as.matrix(hessOrig(theta, ...)) } else { llFunc <- function( theta, ... ) { return( sum( fnOrig( theta, ... ) ) ) } if( !is.null( attr( f, "gradient" ) ) ) { gradFunc <- function( theta, ... ) { return( sumGradients( attr( fnOrig( theta, ... ), "gradient" ), nParam ) ) } } else if( !is.null( gradOrig ) ) { gradFunc <- function( theta, ... ) { return( sumGradients( gradOrig( theta, ... ), nParam ) ) } } else { gradFunc <- NULL } h <- numericHessian(f = llFunc, grad = gradFunc, t0 = theta, fixed=fixed, ...) } } ## Check the correct size of Hessian. if((dim(h)[1] != nParam) | (dim(h)[2] != nParam)) { stop("Wrong hessian dimension. Needed ", nParam, "x", nParam, " but supplied ", dim(h)[1], "x", dim(h)[2]) } else { ## Set elements of the Hessian corresponding to the ## fixed parameters ## to NA so that they are always zero ## (no matter if they are ## calculated analytical or by the finite-difference ## method) h[ fixed, ] <- NA h[ , fixed ] <- NA } } else if( tolower( returnHessian ) == "bhhh" ) { ## We have to return BHHH Hessian. Check if it contains NA in free paramateres, otherwise ## return outer product as Hessian. h <- NULL # to keep track of what we have done if(is.null(dim(gr)) & any(is.na(gr[!fixed]))) { # NA gradient: do not check but send the wrong values to the optimizer. # The optimizer should take corresponding action, such as looking for another value h <- NA } else if(is.matrix(gr)) { if(any(is.na(gr[,!fixed]))) { # NA gradient: do not check but send the wrong values to the optimizer. # The optimizer should take corresponding action, such as looking for another value h <- NA } } if(is.null(h)) { # gr seems not to contain NA-s at free parameters checkBhhhGrad( g = gr, theta = theta, analytic = ( !is.null( attr( f, "gradient" ) ) || !is.null( gradOrig ) ), fixed=fixed) h <- - crossprod( gr ) } attr( h, "type" ) = "BHHH" } else { h <- NULL } ## sum log-likelihood values over observations (if requested) if( sumObs ) { f <- sumKeepAttr( f ) } ## sum gradients over observations (if requested) if( sumObs ) { ## We need just summed gradient gr <- sumGradients( gr, nParam ) } if( !is.null( gradOrig ) && !is.null( attr( f, "gradient" ) ) ) { attr( f, "gradBoth" ) <- TRUE } if( !is.null( hessOrig ) && !is.null( attr( f, "hessian" ) ) ) { attr( f, "hessBoth" ) <- TRUE } attr( f, "gradient" ) <- gr attr( f, "hessian" ) <- h return( f ) } maxLik/R/maxCG.R0000644000176200001440000000266612614234177013043 0ustar liggesusersmaxCG <- function(fn, grad=NULL, hess=NULL, start, fixed = NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ...) { ## Wrapper of optim-based 'Conjugate Gradient' optimization ## ## contraints constraints to be passed to 'constrOptim' ## hessian: how (and if) to calculate the final Hessian: ## FALSE not calculate ## TRUE use analytic/numeric Hessian ## bhhh/BHHH use information equality approach ## ... : further arguments to fn() ## ## Note: grad and hess are for compatibility only, SANN uses only fn values ## if(!inherits(control, "MaxControl")) { mControl <- addControlList(maxControl(iterlim=500), control) # default values } else { mControl <- control } # default, user values mControl <- addControlList(mControl, list(...), check=FALSE) # open values result <- maxOptim( fn = fn, grad = grad, hess = hess, start = start, method = "CG", fixed = fixed, constraints = constraints, finalHessian=finalHessian, parscale = parscale, control=mControl, ... ) return(result) } maxLik/R/addFixedPar.R0000644000176200001440000000025411643232654014205 0ustar liggesusersaddFixedPar <- function( theta, start, fixed, ...) { if( is.null( fixed ) ) { start <- theta } else { start[ !fixed ] <- theta } return( start ) } maxLik/R/maxNR.R0000644000176200001440000001233212660520442013052 0ustar liggesusersmaxNR <- function(fn, grad=NULL, hess=NULL, start, constraints=NULL, finalHessian=TRUE, bhhhHessian=FALSE, fixed=NULL, activePar=NULL, control=NULL, ...) { ## Newton-Raphson maximisation ## Parameters: ## fn - the function to be minimized. Returns either scalar or ## vector value with possible attributes ## constPar and newVal ## grad - gradient function (numeric used if missing). Must return either ## * vector, length=nParam ## * matrix, dim=c(nObs, 1). Treated as vector ## * matrix, dim=c(M, nParam), where M is arbitrary. In this case the ## rows are simply summed (useful for maxBHHH). ## hess - hessian function (numeric used if missing) ## start - initial parameter vector (eventually w/names) ## ... - extra arguments for fn() ## finalHessian include final Hessian? As computing final hessian does not carry any extra penalty for NR method, this option is ## mostly for compatibility reasons with other maxXXX functions. ## TRUE/something else include ## FALSE do not include ## activePar - an index vector -- which parameters are taken as ## variable (free). Other paramters are treated as ## fixed constants ## fixed index vector, which parameters to keep fixed ## ## RESULTS: ## a list of class "maxim": ## maximum function value at maximum ## estimate the parameter value at maximum ## gradient gradient ## hessian Hessian ## code integer code of success: ## 1 - gradient close to zero ## 2 - successive values within tolerance limit ## 3 - could not find a higher point (step error) ## 4 - iteration limit exceeded ## 100 - initial value out of range ## message character message describing the code ## last.step only present if code == 3 (step error). A list with following components: ## theta0 - parameter value which led to the error ## f0 - function value at these parameter values ## climb - the difference between theta0 and the new approximated parameter value (theta1) ## activePar - logical vector, which parameters are active (not constant) ## activePar logical vector, which parameters were treated as free (resp fixed) ## iterations number of iterations ## type "Newton-Raphson maximisation" ## ## ------------------------------ ## Add parameters from ... to control if(!inherits(control, "MaxControl")) { mControl <- addControlList(maxControl(), control) } else { mControl <- control } mControl <- addControlList(mControl, list(...), check=FALSE) ## argNames <- c(c("fn", "grad", "hess", "start", "activePar", "fixed", "control"), openParam(mControl)) # Here we allow to submit all parameters outside of the # 'control' list. May eventually include only a # subset here ## checkFuncArgs( fn, argNames, "fn", "maxNR" ) if( !is.null( grad ) ) { checkFuncArgs( grad, argNames, "grad", "maxNR" ) } if( !is.null( hess ) ) { checkFuncArgs( hess, argNames, "hess", "maxNR" ) } ## establish the active parameters. Internally, we just use 'activePar' fixed <- prepareFixed( start = start, activePar = activePar, fixed = fixed ) ## chop off the control args from ... and forward the new ... dddot <- list(...) dddot <- dddot[!(names(dddot) %in% openParam(mControl))] cl <- list(start=start, finalHessian=finalHessian, bhhhHessian=bhhhHessian, fixed=fixed, control=mControl) if(length(dddot) > 0) { cl <- c(cl, dddot) } ## if(is.null(constraints)) { ## call maxNRCompute with the modified ... list cl <- c(quote(maxNRCompute), fn=logLikAttr, fnOrig = fn, gradOrig = grad, hessOrig = hess, cl) result <- eval(as.call(cl)) } else { if(identical(names(constraints), c("ineqA", "ineqB"))) { stop("Inequality constraints not implemented for maxNR") } else if(identical(names(constraints), c("eqA", "eqB"))) { # equality constraints: A %*% beta + B = 0 cl <- c(quote(sumt), fn=fn, grad=grad, hess=hess, maxRoutine=maxNR, constraints=list(constraints), cl) result <- eval(as.call(cl)) } else { stop("maxNR only supports the following constraints:\n", "constraints=list(ineqA, ineqB)\n", "\tfor A %*% beta + B >= 0 linear inequality constraints\n", "current constraints:", paste(names(constraints), collapse=" ")) } } ## Save the objective function result$objectiveFn <- fn ## return( result ) } maxLik/R/logLik.maxLik.R0000644000176200001440000000047312660242202014470 0ustar liggesusers### Methods for accessing loglik value maximum likelihood estimates logLik.summary.maxLik <- function( object, ...) { ll <- object$loglik attr(ll, "df") <- sum(activePar(object)) ll } logLik.maxLik <- function( object, ...) { ll <- maxValue(object) attr(ll, "df") <- sum(activePar(object)) ll } maxLik/R/nParam.R0000644000176200001440000000040211677651734013256 0ustar liggesusers## Return the #of parameters of model nParam.maxim <- function(x, free=FALSE, ...) { if(!inherits(x, "maxim")) { stop("'nParam.maxim' called on non-'maxim' object") } if(free) sum( activePar( x ) ) else length( x$estimate ) } maxLik/R/condiNumber.R0000644000176200001440000000273112612766327014307 0ustar liggesusers### condiNumber: print matrix' condition number adding columns one by one. ### In this way user may investigate the which columns cause problems with singularity condiNumber <- function(x, ...) UseMethod("condiNumber") condiNumber.default <- function(x, exact=FALSE, norm=FALSE, printLevel=print.level, print.level=1, digits = getOption( "digits" ), ... ) { ## x: a matrix, condition number of which are to be printed ## exact: whether the condition number have to be exact or approximated (see 'kappa') ## norm: whether to normalise the matrix' columns. ## printLevel: whether to print the condition numbers while calculating. Useful for interactive testing. savedDigits <- getOption("digits") options( digits = digits ) if(dim(x)[2] > dim(x)[1]) { warning(paste(dim(x)[1], "rows and", dim(x)[2], "columns, use transposed matrix")) x <- t(x) } cn <- numeric(ncol(x)) if(norm) { # Now normalise column vectors x <- apply(x, 2, FUN=function(v) v/sqrt(sum(v*v))) } for(i in seq(length=ncol(x))) { m <- x[,1:i] cn[i] <- kappa(m, exact=exact) if(printLevel > 0) cat(colnames(x)[i], "\t", cn[i], "\n") } names(cn) <- colnames(x) options( digits = savedDigits ) invisible(cn) } condiNumber.maxLik <- function(x, ...) condiNumber.default( x = hessian(x)[activePar(x), activePar(x),drop=FALSE], ... ) maxLik/R/callWithoutArgs.R0000644000176200001440000000051211355554676015156 0ustar liggesusers## strip arguments "args" and call the function with name "fName" thereafter callWithoutArgs <- function(theta, fName, args, ...) { f <- match.call() f[ args ] <- NULL f[[1]] <- as.name(fName) names(f)[2] <- "" f[["fName"]] <- NULL f[["args"]] <- NULL f1 <- eval(f, sys.frame(sys.parent())) return( f1 ) } maxLik/R/observationGradient.R0000644000176200001440000000053711713530234016040 0ustar liggesusers ### The function tests whether a given gradient is given ### observation-wise. It tests essentially the # of rows ### in the gradient observationGradient <- function(g, nParam) { if(is.null(dim(g))) { if(nParam == 1 & length(g) > 1) return(TRUE) return(FALSE) } if(nrow(g) == 1) return(FALSE) return(TRUE) } maxLik/R/maxSANN.R0000644000176200001440000000356612614234177013311 0ustar liggesusersmaxSANN <- function(fn, grad=NULL, hess=NULL, start, fixed = NULL, control=NULL, constraints = NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ... ) { ## Wrapper of optim-based 'SANN' optimization ## ## contraints constraints to be passed to 'constrOptim' ## finalHessian: how (and if) to calculate the final Hessian: ## FALSE not calculate ## TRUE use analytic/numeric Hessian ## bhhh/BHHH use information equality approach ## ## ... : further arguments to fn() ## ## Note: grad and hess are for compatibility only, SANN uses only fn values if(!inherits(control, "MaxControl")) { mControl <- maxControl(iterlim=10000L) mControl <- addControlList(mControl, control) # default values } else { mControl <- control } mControl <- addControlList(mControl, list(...), check=FALSE) ## save seed of the random number generator if( exists( ".Random.seed" ) ) { savedSeed <- .Random.seed } # set seed for the random number generator (used by 'optim( method="SANN" )') set.seed(slot(mControl, "sann_randomSeed")) # restore seed of the random number generator on exit # (end of function or error) if( exists( "savedSeed" ) ) { on.exit( assign( ".Random.seed", savedSeed, envir = sys.frame() ) ) } else { on.exit( rm( .Random.seed, envir = sys.frame() ) ) } result <- maxOptim( fn = fn, grad = grad, hess = hess, start = start, method = "SANN", fixed = fixed, constraints = constraints, finalHessian=finalHessian, parscale = parscale, control=mControl, ... ) return(result) } maxLik/R/zzz.R0000644000176200001440000000116212215570451012662 0ustar liggesusers.onAttach <- function( lib, pkg ) { packageStartupMessage( paste0( "\nPlease cite the 'maxLik' package as:\n", "Henningsen, Arne and Toomet, Ott (2011). ", "maxLik: A package for maximum likelihood estimation in R. ", "Computational Statistics 26(3), 443-458. ", "DOI 10.1007/s00180-010-0217-1.\n\n", "If you have questions, suggestions, or comments ", "regarding the 'maxLik' package, ", "please use a forum or 'tracker' at maxLik's R-Forge site:\n", "https://r-forge.r-project.org/projects/maxlik/"), domain = NULL, appendLF = TRUE ) } maxLik/R/summary.maxim.R0000644000176200001440000000554611414347724014653 0ustar liggesusersprint.summary.maxim <- function( x, ... ) { summary <- x cat("--------------------------------------------\n") cat(summary$type, "\n") cat("Number of iterations:", summary$iterations, "\n") cat("Return code:", summary$code, "\n") cat(summary$message, "\n") if(!is.null(summary$unsucc.step)) { cat("Last (unsuccessful) step: function value", summary$unsucc.step$value, "\n") print(summary$unsucc.step$parameters) } if(!is.null(summary$estimate)) { cat("Function value:", summary$maximum, "\n") cat("Estimates:\n") print(summary$estimate) if(!is.null(summary$hessian)) { cat("Hessian:\n") print(summary$hessian) } } if(!is.null(summary$constraints)) { cat("\nConstrained optimization based on", summary$constraints$type, "\n") if(!is.null(summary$constraints$code)) cat("Return code:", summary$constraints$code, "\n") # note: this is missing for 'constrOptim' if(!is.null(summary$constraints$message)) cat(summary$constraints$message, "\n") # note: this is missing for 'constrOptim' cat(summary$constraints$outer.iterations, " outer iterations, barrier value", summary$constraints$barrier.value, "\n") } cat("--------------------------------------------\n") } summary.maxim <- function(object, hessian=FALSE, unsucc.step=FALSE, ... ) { ## The object of class "maxim" should include following components: ## maximum : function value at optimum ## estimate : matrix, estimated parameter values and gradient at optimum ## hessian : hessian ## code : code of convergence ## message : message, description of the code ## last.step : information about last step, if unsuccessful ## iterations : number of iterations ## type : type of optimisation ## nParam <- length(object$estimate) if(object$code == 3 & unsucc.step) { a <- cbind(object$last.step$theta0, object$last.step$theta1) dimnames(a) <- list(parameter=object$names, c("current par", "new par")) unsucc.step <- list(value=object$last.step$f0, parameters=a) } else { unsucc.step <- NULL } estimate <- cbind("estimate"=object$estimate, "gradient"=object$gradient) if(hessian) { H <- object$hessian } else { H <- NULL } summary <- list(maximum=object$maximum, type=object$type, iterations=object$iterations, code=object$code, message=object$message, unsucc.step=unsucc.step, estimate=estimate, hessian=H, constraints=object$constraints) class(summary) <- c("summary.maxim", class(summary)) summary } maxLik/R/logLikFunc.R0000644000176200001440000000203612230403441014052 0ustar liggesusersif( getRversion() >= "2.15.1" ) { globalVariables( c( "lastFuncGrad", "lastFuncParam" ) ) } ## objective function: ## sum over possible individual likelihoods logLikFunc <- function(theta, fnOrig, gradOrig, hessOrig, start = NULL, fixed = NULL, sumObs = TRUE, ...) { # Arguments "gradOrig" and "hessOrig" are just for compatibility with # logLikGrad() and logLikHess() theta <- addFixedPar( theta = theta, start = start, fixed = fixed, ...) result <- fnOrig( theta, ... ) ## save gradients and the corresponding parameter values assign( "lastFuncGrad", attr( result, "gradient" ), inherits = TRUE ) assign( "lastFuncParam", theta, inherits = TRUE ) if( sumObs ) { result <- sumKeepAttr( result ) g <- attributes( result )$gradient if( !is.null( g ) ) { g <- sumGradients( g, length( theta ) ) names( g ) <- names( theta ) if( !is.null( fixed ) ) { g <- g[ !fixed ] } attributes( result )$gradient <- g } } return( result ) } maxLik/R/showMaxControl.R0000644000176200001440000000111112604105331014777 0ustar liggesusers showMaxControl <- function(object) { cat("A 'MaxControl' object with slots:\n") for(s in slotNames(object)) { if(s == "sann_cand") { ## This is a function or NULL, handle with care: if(is.null(slot(object, s))) { cat("sann_cand = \n") } else { cat("sann_cand =\n") print(str(slot(object, s))) } } else { ## Just print cat(s, "=", slot(object, s), "\n") } } } setMethod("show", "MaxControl", showMaxControl) maxLik/R/maxNM.R0000644000176200001440000000253512614234177013057 0ustar liggesusersmaxNM <- function(fn, grad=NULL, hess=NULL, start, fixed = NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ...) { ## Wrapper of optim-based 'Nelder-Mead' optimization ## ## contraints constraints to be passed to 'constrOptim' ## hessian: how (and if) to calculate the final Hessian: ## FALSE not calculate ## TRUE use analytic/numeric Hessian ## bhhh/BHHH use information equality approach ## ... : further arguments to fn() ## ## Note: grad and hess are for compatibility only, SANN uses only fn values if(!inherits(control, "MaxControl")) { mControl <- addControlList(maxControl(iterlim=500L), control) # default values } else { mControl <- control } mControl <- addControlList(mControl, list(...), check=FALSE) ## result <- maxOptim( fn = fn, grad = grad, hess = hess, start = start, method = "Nelder-Mead", fixed = fixed, constraints = constraints, finalHessian=finalHessian, parscale = parscale, control=mControl, ... ) return(result) } maxLik/R/maxValue.R0000644000176200001440000000014712657517542013625 0ustar liggesusersmaxValue <- function(x, ...) UseMethod("maxValue") maxValue.maxim <- function(x, ...) x$maximum maxLik/R/20-maxControl.R0000644000176200001440000000114012603402304014356 0ustar liggesusers ### Default constructor of MaxControl object: ### take a list of parameters and overwrite the default values maxControl.default <- function(...) { result <- new("MaxControl") result <- addControlDddot(result, ...) return(result) } ### Standard method for any arguments setGeneric("maxControl", function(x, ...) standardGeneric("maxControl") ) ### Method for 'maxim' objects: fetch the stored MaxControl setMethod("maxControl", "maxim", function(x, ...) x$control) ### Method for missing arguments: just default values setMethod("maxControl", "missing", maxControl.default) maxLik/R/coef.maxLik.R0000644000176200001440000000036511265651123014171 0ustar liggesuserscoef.maxim <- function( object, ... ) { return( object$estimate ) } coef.maxLik <- function( object, ... ) { return( object$estimate ) } coef.summary.maxLik <- function( object, ... ) { result <- object$estimate return( result ) } maxLik/R/maxBFGS.R0000644000176200001440000000244212614234177013263 0ustar liggesusersmaxBFGS <- function(fn, grad=NULL, hess=NULL, start, fixed = NULL, control=NULL, constraints=NULL, finalHessian=TRUE, parscale=rep(1, length=length(start)), ## sumt parameters ...) { ## Wrapper of optim-based 'BFGS' optimization ## ## contraints constraints to be passed to 'constrOptim' ## finalHessian: how (and if) to calculate the final Hessian: ## FALSE not calculate ## TRUE use analytic/numeric Hessian ## bhhh/BHHH use information equality approach ## ## ... further arguments to fn() and grad() if(!inherits(control, "MaxControl")) { mControl <- addControlList(maxControl(iterlim=200), control) # default values } else { mControl <- control } mControl <- addControlList(mControl, list(...), check=FALSE) result <- maxOptim( fn = fn, grad = grad, hess = hess, start = start, method = "BFGS", fixed = fixed, constraints = constraints, finalHessian=finalHessian, parscale = parscale, control=mControl, ... ) return(result) } maxLik/R/maxLik.R0000644000176200001440000000616412563501253013261 0ustar liggesusersmaxLik <- function(logLik, grad=NULL, hess=NULL, start, method, constraints=NULL, ...) { ## Maximum Likelihood estimation. ## ## Newton-Raphson maximisation ## Parameters: ## logLik log-likelihood function. First argument must be the vector of parameters. ## grad gradient of log-likelihood. If NULL, numeric gradient is used. Must return either ## * vector, length=nParam ## * matrix, dim=c(nObs, 1). Treated as vector ## * matrix, dim=c(nObs, nParam). In this case the rows are simply ## summed (useful for maxBHHH). ## hess Hessian function (numeric used if NULL) ## start initial vector of parameters (eventually w/names) ## method maximisation method (Newton-Raphson) ## constraints constrained optimization: a list (see below) ## ... additional arguments for the maximisation routine ## ## RESULTS: ## list of class c("maxLik", "maxim"). This is in fact equal to class "maxim", just the ## methods are different. ## maximum function value at maximum ## estimate the parameter value at maximum ## gradient gradient ## hessian Hessian ## code integer code of success, depends on the optimization ## method ## message character message describing the code ## type character, type of optimization ## ## there may be more components, depending on the choice of ## the algorith. ## argNames <- c( "logLik", "grad", "hess", "start", "method", "constraints" ) checkFuncArgs( logLik, argNames, "logLik", "maxLik" ) if( !is.null( grad ) ) { checkFuncArgs( grad, argNames, "grad", "maxLik" ) } if( !is.null( hess ) ) { checkFuncArgs( hess, argNames, "hess", "maxLik" ) } ## Constrained optimization. We can two possibilities: ## * linear equality constraints ## * linear inequality constraints ## if(missing(method)) { if(is.null(constraints)) { method <- "nr" } else if(identical(names(constraints), c("ineqA", "ineqB"))) { if(is.null(grad)) method <- "Nelder-Mead" else method <- "BFGS" } else method <- "nr" } maxRoutine <- switch(tolower(method), "newton-raphson" =, "nr" = maxNR, "bfgs" = maxBFGS, "bfgsr" =, "bfgs-r" = maxBFGSR, "bhhh" = maxBHHH, "conjugate-gradient" =, "cg" = maxCG, "nelder-mead" =, "nm" = maxNM, "sann" = maxSANN, stop( "Maxlik: unknown maximisation method ", method ) ) result <- maxRoutine(fn=logLik, grad=grad, hess=hess, start=start, constraints=constraints, ...) class(result) <- c("maxLik", class(result)) result } maxLik/R/prepareFixed.R0000644000176200001440000000572611360351735014457 0ustar liggesusersprepareFixed <- function( start, activePar, fixed ) { nParam <- length( start ) ## establish the active parameters. if(!is.null(fixed)) { if(!is.null(activePar)) { if(!all(activePar)) { warning("Both 'activePar' and 'fixed' specified. 'activePar' ignored") } } if( is.logical( fixed ) ) { if( length ( fixed ) != length( start ) || !is.null( dim( fixed ) ) ) { stop( "if fixed parameters are specified using logical values,", " argument 'fixed' must be a logical vector", " with one element for each parameter", " (number of elements in argument 'start')" ) } activePar <- !fixed } else if( is.numeric( fixed ) ) { if( length ( fixed ) >= length( start ) || !is.null( dim( fixed ) ) ) { stop( "if fixed parameters are specified using their positions,", " argument 'fixed' must be a numerical vector", " with less elements than the number of parameters", " (number of elements in argument 'start'" ) } else if( min( fixed ) < 1 || max(fixed ) > length( start ) ) { stop( "if fixed parameters are specified using their positions,", " argument 'fixed' must have values between 1 and", " the total number of parameter", " (number of elements in argument 'start'" ) } activePar <- ! c( 1:length( start ) ) %in% fixed } else if( is.character( fixed ) ) { if( length ( fixed ) >= length( start ) || !is.null( dim( fixed ) ) ) { stop( "if fixed parameters are specified using their names,", " argument 'fixed' must be a vector of character strings", " with less elements than the number of parameters", " (number of elements in argument 'start'" ) } else if( is.null( names( start ) ) ) { stop( "if fixed parameters are specified using their names,", " parameter names have to be specified in argument 'start'" ) } else if( any( ! names( fixed ) %in% names( start ) ) ) { stop( "if fixed parameters are specified using their names,", " all parameter names specified in argument 'fixed'", " must be specified in argument 'start'" ) } activePar <- ! names( start ) %in% fixed } else { stop( "argument 'fixed' must be either a logical vector,", " a numeric vector, or a vector of character strings" ) } } else { if( is.null( activePar ) ) { activePar <- rep( TRUE, length( start ) ) } else if(is.numeric(activePar)) { a <- rep(FALSE, nParam) a[activePar] <- TRUE activePar <- a } } names( activePar ) <- names( start ) if( all( !activePar ) ){ stop( "At least one parameter must not be fixed", " using argument 'fixed'" ) } return( !activePar ) }maxLik/R/nObs.R0000644000176200001440000000131611400733523012723 0ustar liggesusers## Return #of observations for models nObs.maxLik <- function(x, ...) { if( is.null( x$gradientObs ) ) { stop( "cannot return the number of observations:", " please re-run 'maxLik' and", " provide a gradient function using argument 'grad' or", " (if no gradient function is specified) a log-likelihood function", " using argument 'logLik'", " that return the gradients or log-likelihood values, respectively,", " at each observation" ) } else if( is.matrix( x$gradientObs ) ) { return( nrow( x$gradientObs ) ) } else { stop( "internal error: component 'gradientObs' is not a matrix.", " Please contact the developers." ) } } maxLik/R/maximMessage.R0000644000176200001440000000211411643232654014447 0ustar liggesusersmaximMessage <- function(code) { message <- switch(code, "1" = "gradient close to zero", "2" = "successive function values within tolerance limit", "3" = paste("Last step could not find a value above the", "current.\nBoundary of parameter space?", " \nConsider switching to a more robust optimisation method temporarily."), "4" = "Iteration limit exceeded.", "5" = "Infinite value", "6" = "Infinite gradient", "7" = "Infinite Hessian", "8" = "Relative change of the function within relative tolerance", "9" = paste("Gradient did not change,", "cannot improve BFGS approximation for the Hessian.\n", "Use different optimizer and/or analytic gradient."), "100" = "Initial value out of range.", paste("Code", code)) return(message) } maxLik/R/estfun.maxLik.R0000644000176200001440000000104511373217766014570 0ustar liggesusersestfun.maxLik <- function( x, ... ) { if( is.null( x$gradientObs ) ) { stop( "cannot return the gradients of the log-likelihood function", " evaluated at each observation: please re-run 'maxLik' and", " provide a gradient function using argument 'grad' or", " (if no gradient function is specified) a log-likelihood function", " using argument 'logLik'", " that return the gradients or log-likelihood values, respectively,", " at each observation" ) } return( x$gradientObs ) } maxLik/R/05-classes.R0000644000176200001440000000007112577403442013710 0ustar liggesusers## first to be loaded: setOldClass(c("maxLik", "maxim")) maxLik/R/sumt.R0000644000176200001440000001751212612766327013035 0ustar liggesusers### SUMT (Sequential Unconstrained Maximization Technique) ### borrowed from package 'clue' ### ### Adapted for linear constraints sumt <- function(fn, grad=NULL, hess=NULL, start, maxRoutine, constraints, SUMTTol = sqrt(.Machine$double.eps), # difference between estimates for successive outer iterations SUMTPenaltyTol = sqrt(.Machine$double.eps), # maximum allowed penalty SUMTQ = 10, SUMTRho0 = NULL, printLevel=print.level, print.level=0, SUMTMaxIter=100, ...) { ## constraints list w/components eqA and eqB. Maximization will ## be performed wrt to the constraint ## A %*% theta + B = 0 ## The user must ensure the matrices are in correct ## form ## maxSUMTiter how many SUMT iterations to perform max ## penalty <- function(theta) { p <- A %*% theta + B sum(p*p) } ## Penalty gradient and Hessian are used only if corresponding function ## for the likelihood function is provided gPenalty <- function(theta) { 2*(t(theta) %*% t(A) %*% A - t(B) %*% A) } hessPenalty <- function(theta) { 2*t(A) %*% A } ## strip possible arguments of maxRoutine and call the function thereafter callWithoutMaxArgs <- function(theta, fName, ...) { return( callWithoutArgs( theta, fName = fName, args = names(formals(maxRoutine)), ... ) ) } SUMTMessage <- function(code) { message <- switch(code, "1" = "penalty close to zero", "2" = "successive function values within tolerance limit", "4" = "Outer iteration limit exceeded (increase SUMTMaxIter ?).", paste("Code", code)) return(message) } ## the penalized objective function Phi <- function(theta, ...) { llVal <- callWithoutMaxArgs( theta, "logLikFunc", fnOrig = fn, gradOrig = grad, hessOrig = hess, sumObs = FALSE, ... ) llVal <- llVal - rho * penalty( theta ) / length( llVal ) g <- attributes( llVal )$gradient if( !is.null( g ) ) { if( is.matrix( g ) ) { g <- g - matrix( rep( rho * gPenalty( theta ) / nrow( g ), each = nrow( g ) ), nrow = nrow( g ), ncol = ncol( g ) ) } else { g <- g - rho * gPenalty( theta ) } attributes( llVal )$gradient <- g } h <- attributes( llVal )$hessian if( !is.null( h ) ) { attributes( llVal )$hessian <- h - rho * hessPenalty( theta ) } return( llVal ) } ## gradient of the penalized objective function if(!is.null(grad)) { gradPhi<- function(theta, ...) { g <- grad(theta, ...) if(is.matrix(g)) { g <- g - matrix( rep( rho * gPenalty( theta ) / nrow( g ), each = nrow( g ) ), nrow = nrow( g ), ncol = ncol( g ) ) } else { g <- g - rho * gPenalty( theta ) } return( g ) } } else { gradPhi <- NULL } ## Hessian of the penalized objective function if(!is.null(hess)) { hessPhi <- function(theta, ...) { return( hess(theta, ...) - rho*hessPenalty(theta) ) } } else { hessPhi <- NULL } ## -------- SUMT Main code --------- ## Note also that currently we do not check whether optimization was ## "successful" ... A <- constraints$eqA B <- as.matrix(constraints$eqB) ## Check if the matrices conform if(ncol(A) != length(start)) { stop("Equality constraint matrix A must have the same number\n", "of columns as the parameter length ", "(currently ", ncol(A), " and ", length(start), ")") } if(nrow(A) != nrow(B)) { stop("Equality constraint matrix A must have the same number\n", "of rows as the matrix B ", "(currently ", nrow(A), " and ", nrow(B), ")") } ## Find a suitable inital value for rho if not specified if(is.null(SUMTRho0)) { rho <- 0 result <- maxRoutine(fn=Phi, grad=gradPhi, hess=hessPhi, start=start, printLevel=max(printLevel - 1, 0), ...) theta <- coef(result) # Note: this may be a bad idea, # if unconstrained function is unbounded # from above. In that case rather specify SUMTRho0. if(printLevel > 0) { cat("SUMT initial: rho = ", rho, ", function = ", callWithoutMaxArgs( theta, "logLikFunc", fnOrig = fn, gradOrig = grad, hessOrig = hess, ... ), ", penalty = ", penalty(theta), "\n") cat("Estimate:") print(theta) } ## Better upper/lower bounds for rho? rho <- max( callWithoutMaxArgs( theta, "logLikFunc", fnOrig = fn, gradOrig = grad, hessOrig = hess, ... ), 1e-3) / max(penalty(start), 1e-3) } ## if rho specified, simply pick that and use previous initial values else { rho <- SUMTRho0 theta <- start } ## iter <- 1L repeat { thetaOld <- theta result <- maxRoutine(fn=Phi, grad=gradPhi, hess=hessPhi, start=thetaOld, printLevel=max(printLevel - 1, 0), ...) theta <- coef(result) if(printLevel > 0) { cat("SUMT iteration ", iter, ": rho = ", rho, ", function = ", callWithoutMaxArgs( theta, "logLikFunc", fnOrig = fn, gradOrig = grad, hessOrig = hess, ... ), ", penalty = ", penalty(theta), "\n", sep="") cat("Estimate:") print(theta) } if(max(abs(thetaOld - theta)) < SUMTTol) { SUMTCode <- 2 break } if(penalty(theta) < SUMTPenaltyTol) { SUMTCode <- 1 break } if(iter >= SUMTMaxIter) { SUMTCode <- 4 break } iter <- iter + 1L rho <- SUMTQ * rho } ## Now we replace the resulting gradient and Hessian with those, ## calculated on the original function llVal <- callWithoutMaxArgs( theta, "logLikFunc", fnOrig = fn, gradOrig = grad, hessOrig = hess, sumObs = FALSE, ... ) gradient <- attr( llVal, "gradient" ) if( is.null( gradient ) ) { gradient <- callWithoutMaxArgs( theta, "logLikGrad", fnOrig = fn, gradOrig = grad, hessOrig = hess, sumObs = FALSE, ... ) } if( !is.null( dim( gradient ) ) ) { if( nrow( gradient ) > 1 ) { gradientObs <- gradient } gradient <- colSums( gradient ) } else if( length( start ) == 1 && length( gradient ) > 1 ) { gradientObs <- matrix( gradient, ncol = 1 ) gradient <- sum( gradient ) } result$gradient <- gradient names( result$gradient ) <- names( result$estimate ) result$hessian <- callWithoutMaxArgs( theta, "logLikHess", fnOrig = fn, gradOrig = grad, hessOrig = hess, ... ) result$constraints <- list(type="SUMT", barrier.value=penalty(theta), code=SUMTCode, message=SUMTMessage(SUMTCode), outer.iterations=iter ) if( exists( "gradientObs" ) ) { result$gradientObs <- gradientObs colnames( result$gradientObs ) <- names( result$estimate ) } if( result$constraints$barrier.value > 0.001 ) { warning( "problem in imposing equality constraints: the constraints", " are not satisfied (barrier value = ", result$constraints$barrier.value, "). Try setting 'SUMTTol' to 0" ) } return(result) } maxLik/R/numericGradient.R0000644000176200001440000000452511724727024015157 0ustar liggesusersnumericGradient <- function(f, t0, eps=1e-6, fixed, ...) { ## numeric gradient of a vector-valued function ## f function, return Nval x 1 vector of values ## t0 NPar x 1 vector of parameters ## fixed calculate the gradient based on these parameters only ## return: ## NvalxNPar matrix, gradient ## gradient along parameters which are not active are NA warnMessage <- function(theta, value, i) { ## issue a warning if the function value at theta is not a scalar max.print <- 10 if(length(value) != nVal) { warnMsg <- "Function value at\n" warnMsg <- c(warnMsg, paste(format(theta[seq(length=min(max.print,length(theta)))]), collapse=" "), "\n") if(max.print < length(theta)) warnMsg <- c(warnMsg, "...\n") warnMsg <- c(warnMsg, " =\n") warnMsg <- c(warnMsg, paste(format(value[seq(length=min(max.print,length(value)))]), collapse=" "), "\n") if(max.print < length(value)) warnMsg <- c(warnMsg, "...\n") warnMsg <- c(warnMsg, "(length ", length(value), ") does not conform with ", "the length at original value ", nVal, "\n") warnMsg <- c(warnMsg, "Component ", i, " set to NA") return(warnMsg) } if(!all(is.na(value)) & !is.numeric(value)) stop("The function value must be numeric for 'numericGradient'") return(NULL) } NPar <- length(t0) nVal <- length(f0 <- f(t0, ...)) grad <- matrix(NA, nVal, NPar) row.names(grad) <- names(f0) colnames(grad) <- names(t0) if(missing(fixed)) fixed <- rep(FALSE, NPar) for(i in 1:NPar) { if(fixed[i]) next t2 <- t1 <- t0 t1[i] <- t0[i] - eps/2 t2[i] <- t0[i] + eps/2 ft1 <- f(t1, ...) ft2 <- f(t2, ...) ## give meaningful error message if the functions give vectors ## of different length at t1, t2 if(!is.null(msg <- warnMessage(t1, ft1, i))) { warning(msg) ft1 <- NA } if(!is.null(msg <- warnMessage(t2, ft2, i))) { warning(msg) ft2 <- NA } grad[,i] <- (ft2 - ft1)/eps } return(grad) } maxLik/R/maxNRCompute.R0000644000176200001440000004401412620011472014403 0ustar liggesusersmaxNRCompute <- function(fn, start, # maximum lambda for Marquardt (1963) finalHessian=TRUE, bhhhHessian = FALSE, fixed=NULL, control=maxControl(), ...) { ## Newton-Raphson maximisation ## Parameters: ## fn - the function to be maximized. Returns either scalar or ## vector value with possible attributes ## constPar and newVal ## fn must return the value with attributes 'gradient' ## and 'hessian' ## fn must have an argument sumObs ## start - initial parameter vector (eventually w/names) ## control MaxControl object: ## steptol - minimum step size ## lambda0 initial Hessian corrector (see Marquardt, 1963, p 438) ## lambdaStep how much Hessian corrector lambda is changed between ## two lambda trials ## (nu in Marquardt (1963, p 438) ## maxLambda largest possible lambda (if exceeded will give step error) ## lambdatol - max lowest eigenvalue when forcing pos. definite H ## qrtol - tolerance for qr decomposition ## qac How to handle the case where new function value is ## smaller than the original one: ## "stephalving" smaller step in the same direction ## "marquardt" Marquardt (1963) approach ## The stopping criteria ## tol - maximum allowed absolute difference between sequential values ## reltol - maximum allowed reltive difference (stops if < reltol*(abs(fn) + reltol) ## gradtol - maximum allowed norm of gradient vector ## ## iterlim - maximum # of iterations ## ## finalHessian include final Hessian? As computing final hessian does not carry any extra penalty for NR method, this option is ## mostly for compatibility reasons with other maxXXX functions. ## TRUE/something else include ## FALSE do not include ## fixed - a logical vector -- which parameters are taken as fixed. ## Other paramters are treated as variable (free). ## ... additional argument to 'fn'. This may include ## 'fnOrig', 'gradOrig', 'hessOrig' if called fromm ## 'maxNR'. ## ## RESULTS: ## a list of class "maxim": ## maximum function value at maximum ## estimate the parameter value at maximum ## gradient gradient ## hessian Hessian ## code integer code of success: ## 1 - gradient close to zero ## 2 - successive values within tolerance limit ## 3 - could not find a higher point (step error) ## 4 - iteration limit exceeded ## 5 - infinite function value ## 6 infinite gradient ## 7 infinite Hessian ## 100 - initial value out of range ## message character message describing the code ## last.step only present if code == 3 (step error). A list with following components: ## theta0 - parameter value which led to the error ## f0 - function value at these parameter values ## climb - the difference between theta0 and the new approximated parameter value (theta1) ## fixed - logical vector, which parameters are constant (fixed, inactive, non-free) ## fixed logical vector, which parameters were treated as constant (fixed, inactive, non-free) ## iterations number of iterations ## type "Newton-Raphson maximisation" ## ## References: ## Marquardt (1963), "An algorithm for least-squares estimation of nonlinear ## parameters", J. Soc. Indust. Appl. Math 11(2), 431-441 ## max.eigen <- function( M) { ## return maximal eigenvalue of (symmetric) matrix val <- eigen(M, symmetric=TRUE, only.values=TRUE)$values val[1] ## L - eigenvalues in decreasing order, [1] - biggest in abs value } ## ------------------------------------------------- if(slot(control, "qac") == "marquardt") marquardt <- TRUE else marquardt <- FALSE ## maximType <- "Newton-Raphson maximisation" if(marquardt) { maximType <- paste(maximType, "with Marquardt (1963) Hessian correction") } nimed <- names(start) nParam <- length(start) samm <- NULL # data for the last step that could not find a better # value I <- diag(rep(1, nParam)) # I is unit matrix start1 <- start iter <- 0 returnHessian <- ifelse( bhhhHessian, "BHHH", TRUE ) f1 <- fn(start1, fixed = fixed, sumObs = TRUE, returnHessian = returnHessian, ...) if(slot(control, "printLevel") > 2) { cat("Initial function value:", f1, "\n") } if(any(is.na( f1))) { result <- list(code=100, message=maximMessage("100"), iterations=0, type=maximType) class(result) <- "maxim" return(result) } if(any(is.infinite( f1)) && sum(f1) > 0) { # we stop at +Inf but not at -Inf result <- list(code=5, message=maximMessage("5"), iterations=0, type=maximType) class(result) <- "maxim" return(result) } if( isTRUE( attr( f1, "gradBoth" ) ) ) { warning( "the gradient is provided both as attribute 'gradient' and", " as argument 'grad': ignoring argument 'grad'" ) } if( isTRUE( attr( f1, "hessBoth" ) ) ) { warning( "the Hessian is provided both as attribute 'hessian' and", " as argument 'hess': ignoring argument 'hess'" ) } G1 <- attr( f1, "gradient" ) if(slot(control, "printLevel") > 2) { cat("Initial gradient value:\n") print(G1) } if(any(is.na(G1[!fixed]))) { stop("NA in the initial gradient") } if(any(is.infinite(G1[!fixed]))) { stop("Infinite initial gradient") } if(length(G1) != nParam) { stop( "length of gradient (", length(G1), ") not equal to the no. of parameters (", nParam, ")" ) } H1 <- attr( f1, "hessian" ) if(slot(control, "printLevel") > 3) { cat("Initial Hessian value:\n") print(H1) } if(length(H1) == 1) { # Allow the user program to return a # single NA in case of out of support or # other problems if(is.na(H1)) stop("NA in the initial Hessian") } if(any(is.na(H1[!fixed, !fixed]))) { stop("NA in the initial Hessian") } if(any(is.infinite(H1))) { stop("Infinite initial Hessian") } if( slot(control, "printLevel") > 1) { cat( "----- Initial parameters: -----\n") cat( "fcn value:", as.vector(f1), "\n") a <- cbind(start, G1, as.integer(!fixed)) dimnames(a) <- list(nimed, c("parameter", "initial gradient", "free")) print(a) cat( "Condition number of the (active) hessian:", kappa( H1[!fixed, !fixed]), "\n") if( slot(control, "printLevel") > 3) { print( H1) } } lambda1 <- slot(control, "marquardt_lambda0") step <- 1 ## ---------------- Main interation loop ------------------------ repeat { if( iter >= slot(control, "iterlim")) { code <- 4; break } iter <- iter + 1 if(!marquardt) { lambda1 <- 0 # assume the function is concave at start0 } start0 <- start1 f0 <- f1 G0 <- G1 if(any(is.na(G0[!fixed]))) { stop("NA in gradient (at the iteration start)") } H0 <- H1 if(any(is.na(H0[!fixed, !fixed]))) { stop("NA in Hessian (at the iteration start)") } if(marquardt) { lambda1 <- lambda1/slot(control, "marquardt_lambdaStep") # initially we try smaller lambda # lambda1: current lambda for calculations H <- H0 - lambda1*I } else { step <- 1 H <- H0 } ## check whether hessian is positive definite aCount <- 0 # avoid inifinite number of attempts because of # numerical problems while((me <- max.eigen( H[!fixed,!fixed,drop=FALSE])) >= -slot(control, "lambdatol") | (qRank <- qr(H[!fixed,!fixed], tol=slot(control, "qrtol"))$rank) < sum(!fixed)) { # maximum eigenvalue -> negative definite # qr()$rank -> singularity if(marquardt) { lambda1 <- lambda1*slot(control, "marquardt_lambdaStep") } else { lambda1 <- abs(me) + slot(control, "lambdatol") + min(abs(diag(H)[!fixed]))/1e7 # The third term corrects numeric singularity. If diag(H) only contains large values, # (H - (a small number)*I) == H because of finite precision } H <- (H - lambda1*I) # could we multiply it with something like (for stephalving) # *abs(me)*lambdatol # -lambda*I makes the Hessian (barely) # negative definite. # *me*lambdatol keeps the scale roughly # the same as it was before -lambda*I aCount <- aCount + 1 if(aCount > 100) { # should be enough even in the worst case break } } amount <- vector("numeric", nParam) inv <- try(qr.solve(H[!fixed,!fixed,drop=FALSE], G0[!fixed], tol=slot(control, "qrtol"))) if(inherits(inv, "try-error")) { # could not get the Hessian to negative definite samm <- list(theta0=start0, f0=f0, climb=amount) code <- 3 break } amount[!fixed] <- inv start1 <- start0 - step*amount # note: step is always 1 for Marquardt method f1 <- fn(start1, fixed = fixed, sumObs = TRUE, returnHessian = returnHessian, ...) # The call calculates new function, # gradient, and Hessian values ## Are we requested to fix some of the parameters? constPar <- attr(f1, "constPar") if(!is.null(constPar)) { if(any(is.na(constPar))) { stop("NA in the list of constants") } fixed <- rep(FALSE, nParam) fixed[constPar] <- TRUE } ## Are we asked to write in a new value for some of the parameters? if(is.null(newVal <- attr(f1, "newVal"))) { ## no ... if(marquardt) { stepOK <- lambda1 <= slot(control, "marquardt_maxLambda") } else { stepOK <- step >= slot(control, "steptol") } while( any(is.na(f1)) || ( ( sum(f1) < sum(f0) ) & stepOK)) { # We end up in a NA or a higher value. # try smaller step if(marquardt) { lambda1 <- lambda1*slot(control, "marquardt_lambdaStep") H <- (H0 - lambda1*I) amount[!fixed] <- qr.solve(H[!fixed,!fixed,drop=FALSE], G0[!fixed], tol=slot(control, "qrtol")) } else { step <- step/2 } start1 <- start0 - step*amount if(slot(control, "printLevel") > 2) { if(slot(control, "printLevel") > 3) { cat("Try new parameters:\n") print(start1) } cat("function value difference", f1 - f0) if(marquardt) { cat(" -> lambda", lambda1, "\n") } else { cat(" -> step", step, "\n") } } f1 <- fn(start1, fixed = fixed, sumObs = TRUE, returnHessian = returnHessian, ...) # WTF does the 'returnHessian' do here ? ## Find out the constant parameters -- these may be other than ## with full step constPar <- attr(f1, "constPar") if(!is.null(constPar)) { if(any(is.na(constPar))) { stop("NA in the list of constants") } fixed[constPar] <- TRUE ## Any new values requested? if(!is.null(newVal <- attr(f1, "newVal"))) { ## Yes. Write them to parameters and go for ## next iteration start1[newVal$index] <- newVal$val break; } } } if(marquardt) { stepOK <- lambda1 <= slot(control, "marquardt_maxLambda") } else { stepOK <- step >= slot(control, "steptol") } if(!stepOK) { # we did not find a better place to go... start1 <- start0 f1 <- f0 samm <- list(theta0=start0, f0=f0, climb=amount) } } else { ## Yes, indeed. New values given to some of the params. ## Note, this may result in a lower function value, ## hence we do not check f1 > f0 start1[newVal$index] <- newVal$val if( slot(control, "printLevel") > 0 ) { cat( "Keeping parameter(s) ", paste( newVal$index, collapse = ", " ), " at the fixed values ", paste( newVal$val, collapse = ", " ), ", as the log-likelihood function", " returned attributes 'constPar' and 'newVal'\n", sep = "" ) } } G1 <- attr( f1, "gradient" ) if(any(is.na(G1[!fixed]))) { cat("Iteration", iter, "\n") cat("Parameter:\n") print(start1) print(head(G1, n=30)) stop("NA in gradient") } if(any(is.infinite(G1))) { code <- 6; break; } H1 <- attr( f1, "hessian" ) if( slot(control, "printLevel") > 1) { cat( "-----Iteration", iter, "-----\n") } if(any(is.infinite(H1))) { code <- 7; break } if(slot(control, "printLevel") > 2) { cat( "lambda ", lambda1, " step", step, " fcn value:", formatC(as.vector(f1), digits=8, format="f"), "\n") a <- cbind(amount, start1, G1, as.integer(!fixed)) dimnames(a) <- list(names(start0), c("amount", "new param", "new gradient", "active")) print(a) if( slot(control, "printLevel") > 3) { cat("Hessian\n") print( H1) } if(!any(is.na(H1[!fixed, !fixed]))) { cat( "Condition number of the hessian:", kappa(H1[!fixed,!fixed,drop=FALSE]), "\n") } } if( step < slot(control, "steptol")) { # wrong guess in step halving code <- 3; break } if(lambda1 > slot(control, "marquardt_maxLambda")) { # wrong guess in Marquardt method code <- 3; break } if( sqrt( crossprod( G1[!fixed] ) ) < slot(control, "gradtol") ) { code <-1; break } if(is.null(newVal) && sum(f1) - sum(f0) < slot(control, "tol")) { code <- 2; break } if(is.null(newVal) && abs(sum(f1) - sum(f0)) < abs(slot(control, "reltol")*( sum(f1) + slot(control, "reltol")))) { code <- 2; break } if(any(is.infinite(f1)) && sum(f1) > 0) { code <- 5; break } } if( slot(control, "printLevel") > 0) { cat( "--------------\n") cat( maximMessage( code), "\n") cat( iter, " iterations\n") cat( "estimate:", start1, "\n") cat( "Function value:", f1, "\n") } names(start1) <- nimed F1 <- fn( start1, fixed = fixed, sumObs = FALSE, returnHessian = ( finalHessian == TRUE ), ... ) G1 <- attr( F1, "gradient" ) if(observationGradient(G1, length(start1))) { gradientObs <- G1 colnames( gradientObs ) <- nimed G1 <- colSums(as.matrix(G1 )) } else { gradientObs <- NULL } names( G1 ) <- nimed ## calculate (final) Hessian if(tolower(finalHessian) == "bhhh") { if(!is.null(gradientObs)) { hessian <- - crossprod( gradientObs ) attr(hessian, "type") <- "BHHH" } else { hessian <- NULL warning("For computing the final Hessian by 'BHHH' method, the log-likelihood or gradient must be supplied by observations") } } else if( finalHessian != FALSE ) { hessian <- attr( F1, "hessian" ) } else { hessian <- NULL } if( !is.null( hessian ) ) { rownames( hessian ) <- colnames( hessian ) <- nimed } ## remove attributes from final value of objective (likelihood) function attributes( f1 )$gradient <- NULL attributes( f1 )$hessian <- NULL attributes( f1 )$gradBoth <- NULL attributes( f1 )$hessBoth <- NULL ## result <-list( maximum = unname( drop( f1 ) ), estimate=start1, gradient=drop(G1), hessian=hessian, code=code, message=maximMessage( code), last.step=samm, # only when could not find a # lower point fixed=fixed, iterations=iter, type=maximType) if( exists( "gradientObs" ) ) { result$gradientObs <- gradientObs } result <- c(result, control=control) # attach the control parameters ## class(result) <- c("maxim", class(result)) invisible(result) } returnCode.maxim <- function(x, ...) x$code maxLik/R/maxOptim.R0000644000176200001440000002777512660520442013644 0ustar liggesusersmaxOptim <- function(fn, grad, hess, start, method, fixed, constraints, finalHessian=TRUE, parscale, control=maxControl(), ...) { ## Wrapper of optim-based optimization methods ## ## finalHessian: how (and if) to calculate the final Hessian: ## FALSE not calculate ## TRUE use analytic/numeric Hessian ## bhhh/BHHH use information equality approach ## if( method == "Nelder-Mead" ) { maxMethod <- "maxNM" } else { maxMethod <- paste( "max", method, sep = "" ) } ## ## Add parameters from ... to control if(!inherits(control, "MaxControl")) { stop("'control' must be a 'MaxControl' object, created by 'maxControl()'") } control <- addControlList(control, list(...), check=FALSE) ## Any forbidden arguments in fn? argNames <- c( "fn", "grad", "hess", "start", "print.level", "iterlim", "constraints", "tol", "reltol", "parscale", "alpha", "beta", "gamma", "cand", "temp", "tmax" ) checkFuncArgs( fn, argNames, "fn", maxMethod ) if( !is.null( grad ) ) { checkFuncArgs( grad, argNames, "grad", maxMethod ) } if( !is.null( hess ) ) { checkFuncArgs( hess, argNames, "hess", maxMethod ) } ## check argument 'fixed' fixed <- prepareFixed( start = start, activePar = NULL, fixed = fixed ) message <- function(c) { switch(as.character(c), "0" = "successful convergence", "1" = "iteration limit exceeded", "10" = "degeneracy in Nelder-Mead simplex", "51" = "warning from the 'L-BFGS-B' method; see the corresponding component 'message' for details", "52" = "error from the 'L-BFGS-B' method; see the corresponding component 'message' for details" ) } ## initialize variables for saving gradients provided as attributes ## and the corresponding parameter values lastFuncGrad <- NULL lastFuncParam <- NULL ## chop off the control args from '...' and forward the new '...' dddot <- list(...) dddot <- dddot[!(names(dddot) %in% openParam(control))] # unfortunately now you have to do # do.call(function, args, dddot) instead of just calling # func(args, ...) ## strip possible SUMT parameters and call the function thereafter environment( callWithoutSumt ) <- environment() maximType <- paste( method, "maximization" ) parscale <- rep(parscale, length.out=length(start)) oControl <- list(trace=max(slot(control, "printLevel"), 0), REPORT=1, fnscale=-1, reltol=slot(control, "tol"), maxit=slot(control, "iterlim"), parscale=parscale[ !fixed ], alpha=slot(control, "nm_alpha"), beta=slot(control, "nm_beta"), gamma=slot(control, "nm_gamma"), temp=slot(control, "sann_temp"), tmax=slot(control, "sann_tmax") ) oControl$reltol <- slot(control, "reltol") argList <- list(theta=start, fName="logLikFunc", fnOrig = fn, gradOrig = grad, hessOrig = hess) if(length(dddot) > 0) { argList <- c(argList, dddot) } f1 <- do.call(callWithoutSumt, argList) if(is.na( f1)) { result <- list(code=100, message=maximMessage("100"), iterations=0, type=maximType) class(result) <- "maxim" return(result) } if(slot(control, "printLevel") > 2) { cat("Initial function value:", f1, "\n") } hasGradAttr <- !is.null( attr( f1, "gradient" ) ) if( hasGradAttr && !is.null( grad ) ) { grad <- NULL warning( "the gradient is provided both as attribute 'gradient' and", " as argument 'grad': ignoring argument 'grad'" ) } hasHessAttr <- !is.null( attr( f1, "hessian" ) ) if( hasHessAttr && !is.null( hess ) ) { hess <- NULL warning( "the Hessian is provided both as attribute 'hessian' and", " as argument 'hess': ignoring argument 'hess'" ) } if( method == "BFGS" ) { argList <- list(theta=start, fName="logLikGrad", fnOrig = fn, gradOrig = grad, hessOrig = hess) if(length(dddot) > 0) { argList <- c(argList, dddot) } G1 <- do.call(callWithoutSumt, argList) if(slot(control, "printLevel") > 2) { cat("Initial gradient value:\n") print(G1) } if(any(is.na(G1))) { stop("NA in the initial gradient") } if(any(is.infinite(G1))) { stop("Infinite initial gradient") } if(length(G1) != length(start)) { stop( "length of gradient (", length(G1), ") not equal to the no. of parameters (", length(start), ")" ) } } ## function to return the gradients (BFGS, CG) or the new candidate point (SANN) if( method == "BFGS" ) { gradOptim <- logLikGrad } else if( method == "SANN" ) { if( is.null(slot(control, "sann_cand") ) ) { gradOptim <- NULL } else { gradOptim <- function( theta, fnOrig, gradOrig, hessOrig, start, fixed, ... ) { return(control@sann_cand( theta, ... ) ) } } } else if( method == "CG" ) { gradOptim <- logLikGrad } else if( method == "Nelder-Mead" ) { gradOptim <- NULL } else { stop( "internal error: unknown method '", method, "'" ) } ## A note about return value: ## We can the return from 'optim' in a object of class 'maxim'. ## However, as 'sumt' already returns such an object, we return the ## result of 'sumt' directly, without the canning if(is.null(constraints)) { cl <- list(quote(optim), par = start[ !fixed ], fn = logLikFunc, control = oControl, method = method, gr = gradOptim, fnOrig = fn, gradOrig = grad, hessOrig = hess, start = start, fixed = fixed) if(length(dddot) > 0) { cl <- c(cl, dddot) } result <- eval(as.call(cl)) resultConstraints <- NULL } else { ## linear equality and inequality constraints # inequality constraints: A %*% beta + B >= 0 if(identical(names(constraints), c("ineqA", "ineqB"))) { nra <- nrow(constraints$ineqA) nrb <- nrow(as.matrix(constraints$ineqB)) ncb <- ncol(as.matrix(constraints$ineqB)) if(ncb != 1) { stop("Inequality constraint B must be a vector ", "(or Nx1 matrix). Currently ", ncb, " columns") } if(length(dim(constraints$ineqA)) != 2) { stop("Inequality constraint A must be a matrix\n", "Current dimension", dim(constraints$ineqA)) } if(ncol(constraints$ineqA) != length(start)) { stop("Inequality constraint A must have the same ", "number of columns as length of the parameter.\n", "Currently ", ncol(constraints$ineqA), " and ", length(start), ".") } if(ncol(constraints$ineqA) != length(start)) { stop("Inequality constraint A cannot be matrix multiplied", " with the start value.\n", "A is a ", nrow(constraints$ineqA), "x", ncol(constraints$ineqA), " matrix,", " start value has lenght ", length(start)) } if(nra != nrb) { stop("Inequality constraints A and B suggest different number ", "of constraints: ", nra, " and ", nrb) } cl <- list(quote(constrOptim2), theta = start, f = logLikFunc, grad = gradOptim, ineqA=constraints$ineqA, ineqB=constraints$ineqB, control=oControl, method = method, fnOrig = fn, gradOrig = grad, hessOrig = hess, fixed = fixed, start=start) # 'start' argument is needed for adding fixed parameters later in the call chain if(length(dddot) > 0) { cl <- c(cl, dddot) } result <- eval(as.call(cl)) resultConstraints <- list(type="constrOptim", barrier.value=result$barrier.value, outer.iterations=result$outer.iterations ) } else if(identical(names(constraints), c("eqA", "eqB"))) { # equality constraints: A %*% beta + B = 0 argList <- list(fn=fn, grad=grad, hess=hess, start=start, fixed = fixed, maxRoutine = get( maxMethod ), constraints=constraints, parscale = parscale, control=control) # recursive evaluation-> pass original (possibly # supplemented) control if(length(dddot) > 0) { argList <- c(argList, dddot) } result <- do.call( sumt, argList[ !sapply( argList, is.null ) ] ) return(result) # this is already maxim object } else { stop( maxMethod, " only supports the following constraints:\n", "constraints=list(ineqA, ineqB)\n", "\tfor A %*% beta + B >= 0 linear inequality constraints\n", "current constraints:", paste(names(constraints), collapse=" ")) } } # estimates (including fixed parameters) estimate <- start estimate[ !fixed ] <- result$par ## Calculate the final gradient argList <- list(estimate, "logLikGrad", fnOrig = fn, gradOrig = grad, hessOrig = hess, sumObs = FALSE) if(length(dddot) > 0) { argList <- c(argList, dddot) } gradient <- do.call(callWithoutSumt, argList) if(observationGradient(gradient, length(start))) { gradientObs <- gradient gradient <- colSums(as.matrix(gradient )) } else { gradientObs <- NULL } ## calculate (final) Hessian if(tolower(finalHessian) == "bhhh") { if(!is.null(gradientObs)) { hessian <- - crossprod( gradientObs ) attr(hessian, "type") <- "BHHH" } else { hessian <- NULL warning("For computing the final Hessian by 'BHHH' method, the log-likelihood or gradient must be supplied by observations") } } else if(finalHessian != FALSE) { argList <- list( estimate, fnOrig = fn, gradOrig = grad, hessOrig = hess) if(length(dddot) > 0) { argList <- c(argList, dddot) } hessian <- as.matrix( do.call(logLikHess, argList) ) } else { hessian <- NULL } if( !is.null( hessian ) ) { rownames( hessian ) <- colnames( hessian ) <- names( estimate ) } result <- list( maximum=result$value, estimate=estimate, gradient=drop(gradient), # ensure the final (non-observation) gradient is just a vector hessian=hessian, code=result$convergence, message=paste(message(result$convergence), result$message), last.step=NULL, fixed = fixed, iterations=result$counts[1], type=maximType, constraints=resultConstraints ) if( exists( "gradientObs" ) ) { result$gradientObs <- gradientObs } result <- c(result, control=control, objectiveFn=fn) # attach the control parameters class(result) <- "maxim" return(result) } maxLik/R/logLikGrad.R0000644000176200001440000000414511643232654014054 0ustar liggesusers## gradient function: ## sum over possible individual gradients logLikGrad <- function(theta, fnOrig, gradOrig, hessOrig, start = NULL, fixed = NULL, sumObs = TRUE, gradAttr = NULL, ...) { # Argument "hessOrig" is just for compatibility with logLikHess() # argument "gradAttr" should be # - FALSE if the gradient is not provided as attribute of the log-lik value # - TRUE if the gradient is provided as attribute of the log-lik value # - NULL if this is not known theta <- addFixedPar( theta = theta, start = start, fixed = fixed, ...) if(!is.null(gradOrig)) { g <- gradOrig(theta, ...) } else if( isTRUE( gradAttr ) || is.null( gradAttr ) ) { if( exists( "lastFuncGrad" ) && exists( "lastFuncParam" ) ) { if( identical( theta, lastFuncParam ) ) { g <- lastFuncGrad } else { g <- "different parameters" } } else { g <- "'lastFuncGrad' or 'lastFuncParam' does not exist" } if( is.character( g ) ) { # do not call fnOrig() if 'lastFuncGrad' is NULL g <- attr( fnOrig( theta, ... ), "gradient" ) } } else { g <- NULL } if( is.null( g ) ) { g <- numericGradient(logLikFunc, theta, fnOrig = fnOrig, sumObs = sumObs, ...) } if( sumObs ) { ## We were requested a single (summed) gradient. Return a vector g <- sumGradients( g, length( theta ) ) names( g ) <- names( theta ) if( !is.null( fixed ) ) { g <- g[ !fixed ] } } else { ## we were requested individual gradients (if possible). Ensure g is a matrix if(observationGradient(g, length(theta))) { ## it was indeed by observations g <- as.matrix(g) colnames( g ) <- names( theta ) if( !is.null( fixed ) ) { g <- g[ , !fixed ] } } else { ## it wasn't g <- drop(g) names(g) <- names(theta) if( !is.null( fixed ) ) { g <- g[ !fixed ] } } } return( g ) } maxLik/R/print.maxLik.R0000644000176200001440000000064011414352057014405 0ustar liggesusersprint.maxLik <- function( x, ... ) { cat("Maximum Likelihood estimation\n") cat(maximType(x), ", ", nIter(x), " iterations\n", sep="") cat("Return code ", returnCode(x), ": ", returnMessage(x), "\n", sep="") if(!is.null(x$estimate)) { cat("Log-Likelihood:", x$maximum ) cat( " (", sum( activePar( x ) ), " free parameter(s))\n", sep = "" ) cat("Estimate(s):", x$estimate, "\n" ) } } maxLik/R/fnSubset.R0000644000176200001440000000272011061103077013611 0ustar liggesusersfnSubset <- function(x, fnFull, xFixed, xFull=c(x, xFixed), ...){ ## ## 1. Confirm length(x)+length(xFixed) = length(xFull) ## nx <- length(x) nFixed <- length(xFixed) nFull <- length(xFull) if((nx+nFixed) != nFull) stop("length(x)+length(xFixed) != length(xFull): ", nx, " + ", nFixed, " != ", nFull) ## ## 2. names(xFull)? ## # 2.1. is.null(names(xFull)) if(is.null(names(xFull))) return(fnFull(c(x, xFixed), ...)) # 2.2. xFull[names(xFixed)] <- xFixed, ... { if(is.null(names(xFixed))){ if(is.null(names(x))) xFull <- c(x, xFixed) else { x. <- (names(xFull) %in% names(x)) if(sum(x.) != nx){ print(x) print(xFull) stop("x has names not in xFull.") } xFull[names(x)] <- x xFull[!x.] <- xFixed } } else { Fixed <- (names(xFull) %in% names(xFixed)) if(sum(Fixed) != nFixed){ print(xFixed) print(xFull) stop("xFixed has names not in xFull.") } xFull[names(xFixed)] <- xFixed { if(is.null(names(x))) xFull[!Fixed] <- x else { x. <- (names(xFull) %in% names(x)) if(sum(x.) != nx){ print(x) print(xFull) stop("x has names not in xFull.") } xFull[names(x)] <- x } } } } ## ## 3. fnFull(...) ## fnFull(xFull, ...) } maxLik/R/sumGradients.R0000644000176200001440000000037211413611733014472 0ustar liggesuserssumGradients <- function( gr, nParam ) { if( !is.null(dim(gr))) { gr <- colSums(gr) } else { ## ... or vector if only one parameter if( nParam == 1 && length( gr ) > 1 ) { gr <- sum(gr) } } return( gr ) }maxLik/R/maxBFGSR.R0000644000176200001440000001245612660520442013405 0ustar liggesusers maxBFGSR <- function(fn, grad=NULL, hess=NULL, start, constraints=NULL, finalHessian=TRUE, fixed=NULL, activePar=NULL, control=NULL, ...) { ## Newton-Raphson maximization ## Parameters: ## fn - the function to be minimized. Returns either scalar or ## vector value with possible attributes ## constPar and newVal ## grad - gradient function (numeric used if missing). Must return either ## * vector, length=nParam ## * matrix, dim=c(nObs, 1). Treated as vector ## * matrix, dim=c(M, nParam), where M is arbitrary. In this case the ## rows are simply summed (useful for maxBHHH). ## hess - hessian function (numeric used if missing) ## start - initial parameter vector (eventually w/names) ## ... - extra arguments for fn() ## The maxControl structure: ## The stopping criteria ## tol - maximum allowed absolute difference between sequential values ## reltol - maximum allowed reltive difference (stops if < reltol*(abs(fn) + reltol) ## gradtol - maximum allowed norm of gradient vector ## steptol - minimum step size ## iterlim - maximum # of iterations ## finalHessian include final Hessian? As computing final hessian does not carry any extra penalty for NR method, this option is ## mostly for compatibility reasons with other maxXXX functions. ## TRUE/something else include ## FALSE do not include ## activePar - an index vector -- which parameters are taken as ## variable (free). Other paramters are treated as ## fixed constants ## fixed index vector, which parameters to keep fixed ## ## RESULTS: ## a list of class "maxim": ## maximum function value at maximum ## estimate the parameter value at maximum ## gradient gradient ## hessian Hessian ## code integer code of success: ## 1 - gradient close to zero ## 2 - successive values within tolerance limit ## 3 - could not find a higher point (step error) ## 4 - iteration limit exceeded ## 100 - initial value out of range ## message character message describing the code ## last.step only present if code == 3 (step error). A list with following components: ## theta0 - parameter value which led to the error ## f0 - function value at these parameter values ## climb - the difference between theta0 and the new approximated parameter value (theta1) ## activePar - logical vector, which parameters are active (not constant) ## activePar logical vector, which parameters were treated as free (resp fixed) ## iterations number of iterations ## type "Newton-Raphson maximization" ## ## ------------------------------ ## Add parameters from ... to control if(!inherits(control, "MaxControl")) { mControl <- addControlList(maxControl(), control) } else { mControl <- control } mControl <- addControlList(mControl, list(...), check=FALSE) ## argNames <- c(c( "fn", "grad", "hess", "start", "activePar", "fixed", "control"), openParam(mControl)) checkFuncArgs( fn, argNames, "fn", "maxBFGSR" ) if( !is.null( grad ) ) { checkFuncArgs( grad, argNames, "grad", "maxBFGSR" ) } if( !is.null( hess ) ) { checkFuncArgs( hess, argNames, "hess", "maxBFGSR" ) } ## establish the active parameters. Internally, we just use 'activePar' fixed <- prepareFixed( start = start, activePar = activePar, fixed = fixed ) ## chop off the control args from ... and forward the new ... dddot <- list(...) dddot <- dddot[!(names(dddot) %in% openParam(mControl))] cl <- list(start=start, finalHessian=finalHessian, fixed=fixed, control=mControl) if(length(dddot) > 0) { cl <- c(cl, dddot) } if(is.null(constraints)) { cl <- c(quote(maxBFGSRCompute), fn=logLikAttr, fnOrig = fn, gradOrig = grad, hessOrig = hess, cl) result <- eval(as.call(cl)) } else { if(identical(names(constraints), c("ineqA", "ineqB"))) { stop("Inequality constraints not implemented for maxBFGSR") } else if(identical(names(constraints), c("eqA", "eqB"))) { # equality constraints: A %*% beta + B = 0 cl <- c(quote(sumt), fn=fn, grad=grad, hess=hess, maxRoutine=maxBFGSR, constraints=list(constraints), cl) result <- eval(as.call(cl)) } else { stop("maxBFGSR only supports the following constraints:\n", "constraints=list(ineqA, ineqB)\n", "\tfor A %*% beta + B >= 0 linear inequality constraints\n", "current constraints:", paste(names(constraints), collapse=" ")) } } result$objectiveFn <- fn return( result ) } maxLik/R/25-addControlList.R0000644000176200001440000000537412614234177015214 0ustar liggesusers ## Function overwrite parameters of an existing MaxControl object using ## parameters supplied in a single list. ## We do not make it to a method: the signature would be indistinguishable ## from add(maxControl, ...) where ... is a single list addControlList <- function(x, y, check=TRUE) { ## add list y to the control ## ## check only accept known control options. ## useful if attaching known control list ## if false, no checks performed and can add arbitrary list ## setSlot <- function(openName, slotName=openName[1], convert=function(x) x ) { ## Store potentially differently named value in slot ## ## openName vector of accepted name forms ## slotName corresponding actual slot name ## convert how to convert the value ## if(!any(openName %in% names(y))) { return(NULL) } i <- tail(which(names(y) %in% openName), 1) # pick the last occurrence: allow user to overwrite defaults slot(x, slotName) <- convert(y[[i]]) assign("x", x, envir=parent.frame()) # save modified x into parent frame } if(!inherits(x, "MaxControl")) { stop("'x' must be of class 'MaxControl'") } if(is.null(y)) { return(x) } if(!inherits(y, "list")) { stop("Control arguments to 'maxControl' must be supplied in the form of a list") } if(check) { knownNames <- union(openParam(x), slotNames(x)) if(any(uNames <- !(names(y) %in% knownNames))) { cat("Unknown control options:\n") print(names(y)[uNames]) stop("Unknown options not accepted") } } ## setSlot("tol") setSlot("reltol") setSlot("gradtol") setSlot("lambdatol") setSlot("qrtol") ## QAC setSlot(c("qac", "QAC"), "qac") setSlot(c("marquardt_lambda0", "Marquardt_lambda0")) setSlot(c("marquardt_lambdaStep", "Marquardt_lambdaStep")) setSlot(c("marquardt_maxLambda", "Marquardt_maxLambda")) ## NM setSlot(c("nm_alpha", "NM_alpha", "alpha")) setSlot(c("nm_beta", "NM_beta", "beta")) setSlot(c("nm_gamma", "NM_gamma", "gamma")) ## SANN setSlot(c("sann_cand", "SANN_cand", "cand")) setSlot(c("sann_temp", "SANN_temp", "temp")) setSlot(c("sann_tmax", "SANN_tmax", "tmax"), convert=as.integer) setSlot(c("sann_randomSeed", "SANN_randomSeed", "random.seed"), convert=as.integer) ## setSlot("iterlim", convert=as.integer) setSlot(c("printLevel", "print.level"), convert=as.integer) ## validObject(x) return(x) } ### Method for 'MaxControl' objects: add the second argument, list setMethod("maxControl", signature("MaxControl"), addControlList) maxLik/R/10-MaxControl_class.R0000644000176200001440000001317712604622732015531 0ustar liggesusers ### shoud move checkMaxControl to a separate file but how to do it? setClassUnion("functionOrNULL", c("function", "NULL")) checkMaxControl <- function(object) { ## check validity of MaxControl objects if(!inherits(object, "MaxControl")) { stop("'MaxControl' object required. Currently '", class(object), "'") } ## errors <- character(0) ## Check length of componenents for(s in slotNames(object)) { if(s == "sann_cand") { if(length(slot(object, s)) > 1) { errors <- c(errors, paste("'", s, "' must be either 'NULL' or ", "a function of length 1, not of length ", length(slot(object, s)), sep="")) } } else if(length(slot(object, s)) != 1) { errors <- c(errors, paste("'", s, "' must be of length 1, not ", length(slot(object, s)), sep="")) } } ## if(slot(object, "tol") < 0) { errors <- c(errors, paste("'tol' must be non-negative, not ", slot(object, "tol"), sep="")) } if(slot(object, "reltol") < 0) { errors <- c(errors, paste("'reltol' must be non-negative, not ", slot(object, "reltol"), sep="")) } if(slot(object, "gradtol") < 0) { errors <- c(errors, paste("'gradtol' must be non-negative, not", slot(object, "gradtol"))) } if(slot(object, "steptol") < 0) { errors <- c(errors, paste("'steptol' must be non-negative, not", slot(object, "steptol"))) } if(slot(object, "lambdatol") < 0) { errors <- c(errors, paste("'lambdatol' must be non-negative, not", slot(object, "lambdatol"))) } if(!pmatch(slot(object, "qac"), c("stephalving", "marquardt"))) { errors <- c(errors, paste("'qac' must be 'stephalving' or 'marquadt', not", slot(object, "qac"))) } if(slot(object, "qrtol") < 0) { errors <- c(errors, paste("'qrtol' must be non-negative, not", slot(object, "qrtol"))) } if(slot(object, "marquardt_lambda0") < 0) { errors <- c(errors, paste("'lambda0' must be non-negative, not", slot(object, "lambda0"))) } if(slot(object, "marquardt_lambdaStep") <= 1) { errors <- c(errors, paste("'lambdaStep' must be > 1, not", slot(object, "lambdaStep"))) } if(slot(object, "marquardt_maxLambda") < 0) { errors <- c(errors, paste("'maxLambda' must be non-negative, not", slot(object, "maxLambda"))) } ## NM if(slot(object, "nm_alpha") < 0) { errors <- c(errors, paste("Nelder-Mead reflection factor 'alpha' ", "must be non-negative, not", slot(object, "nm_alpha"))) } if(slot(object, "nm_beta") < 0) { errors <- c(errors, paste("Nelder-Mead contraction factor 'beta' ", "must be non-negative, not", slot(object, "nm_beta"))) } if(slot(object, "nm_gamma") < 0) { errors <- c(errors, paste("Nelder-Mead expansion factor 'gamma' ", "must be non-negative, not", slot(object, "nm_gamma"))) } ## SANN if(!inherits(slot(object, "sann_cand"), c("function", "NULL"))) { # errors <- c(errors, paste("'SANN_cand' must be either NULL or a function, not", slot(object, "SANN_cand"))) } if(slot(object, "sann_tmax") < 1) { errors <- c(errors, paste("SANN number of calculations at each temperature ", "'tmax' ", "must be positive, not", slot(object, "sann_tmax"))) } ## if(slot(object, "iterlim") < 0) { errors <- c(errors, paste("'iterlim' must be non-negative, not", slot(object, "iterlim"))) } if(length(errors) > 0) return(errors) return(TRUE) } ### MaxControls contains all control parameters for max* family setClass("MaxControl", slots=representation( tol="numeric", reltol="numeric", gradtol="numeric", steptol="numeric", # lambdatol="numeric", qrtol="numeric", ## Qadratic Approximation Control qac="character", marquardt_lambda0="numeric", marquardt_lambdaStep="numeric", marquardt_maxLambda="numeric", ## Optim Nelder-Mead: nm_alpha="numeric", nm_beta="numeric", nm_gamma="numeric", ## SANN sann_cand="functionOrNULL", sann_temp="numeric", sann_tmax="integer", sann_randomSeed="integer", ## iterlim="integer", ## printLevel="integer"), ## prototype=prototype( tol=1e-8, reltol=sqrt(.Machine$double.eps), gradtol=1e-6, steptol=1e-10, # lambdatol=1e-6, # qac="stephalving", qrtol=1e-10, marquardt_lambda0=1e-2, marquardt_lambdaStep=2, marquardt_maxLambda=1e12, ## Optim Nelder-Mead nm_alpha=1, nm_beta=0.5, nm_gamma=2, ## SANN sann_cand=NULL, sann_temp=10, sann_tmax=10L, sann_randomSeed=123L, ## iterlim=150L, printLevel=0L), ## validity=checkMaxControl) maxLik/R/nIter.R0000644000176200001440000000030210760501406013076 0ustar liggesusers## Return #of iterations for maxim objects nIter <- function(x, ...) ## Number of iterations for iterative models UseMethod("nIter") nIter.default <- function(x, ...) x$iterations maxLik/R/gradient.R0000644000176200001440000000021212660242202013607 0ustar liggesusers## Return Hessian of an object gradient <- function(x, ...) UseMethod("gradient") gradient.maxim <- function(x, ...) x$gradient maxLik/R/constrOptim2.R0000644000176200001440000001227612230403441014427 0ustar liggesusers# This file is a modified copy of src/library/stats/R/constrOptim.R # Part of the R package, http://www.R-project.org ### This foutine is not intended for end-user use. ### API is subject to change. constrOptim2<-function(theta, f,grad=NULL, ineqA,ineqB, mu=0.0001,control=list(), method=if(is.null(grad)) "Nelder-Mead" else "BFGS", outer.iterations=100,outer.eps=0.00001, ...){ ## Optimize with inequality constraint using SUMT/logarithmic ## barrier ## ## start initial value of parameters, included the fixed ones ## ## This function has to operate with free parameter components ## only as 'optim' cannot handle ## fixed parameters. However, for computing constraints in ## 'R' and 'dR' we have to use the complete parameter vector. ## R <- function(thetaFree, thetaFree.old, ...) { ## Wrapper for the function. As this will be feed to the ## 'optim', we have to call it with free parameters only ## (thetaFree) and internally expand it to the full (theta) ## ## Were we called with 'fixed' argument in ... ? dotdotdot <- list(...) # can this be made better? fixed <- dotdotdot[["fixed"]] theta <- addFixedPar( theta = thetaFree, start = theta0, fixed = fixed) theta.old <- addFixedPar( theta = thetaFree.old, start = theta0, fixed = fixed) ineqA.theta<-ineqA%*%theta gi<- ineqA.theta + ineqB if(any(gi < 0)) ## at least one of the constraints not fulfilled return(NaN) gi.old <- ineqA%*%theta.old + ineqB bar <- sum(gi.old*log(gi) - ineqA.theta) # logarithmic barrier value: sum over # components if(!is.finite(bar)) bar<- -Inf result <- f(thetaFree, ...)-mu*bar # do not send 'fixed' and 'start' to the # function here -- we have already # expanded theta to the full parameter result } dR<-function(thetaFree, thetaFree.old, ...){ ## Wrapper for the function. As this will be feed to the 'optim', ## we have to call it with free parameters only (thetaFree) and ## internally expand it to the full (theta) ## ## Were we called with 'fixed' argument in ... ? dotdotdot <- list(...) # can this be made better? fixed <- dotdotdot[["fixed"]] theta <- addFixedPar( theta = thetaFree, start = theta0, fixed = fixed) theta.old <- addFixedPar( theta = thetaFree.old, start = theta0, fixed = fixed) ineqA.theta<-ineqA%*%theta gi<-drop(ineqA.theta + ineqB) gi.old<-drop(ineqA%*%theta.old + ineqB) dbar<-colSums( ineqA*gi.old/gi-ineqA) if(!is.null(fixed)) gr <- grad(thetaFree,...)- (mu*dbar)[!fixed] # grad only gives gradient for the free parameters in order to maintain # compatibility with 'optim'. Hence we compute barrier gradient # for the free parameters only as well. else gr <- grad(thetaFree,...)- (mu*dbar) return(gr) } if (!is.null(control$fnscale) && control$fnscale<0) mu <- -mu ##maximizing if(any(ineqA%*%theta + ineqB < 0)) stop("initial value not the feasible region") theta0 <- theta # inital value, for keeping the fixed params ## Were we called with 'fixed' argument in ... ? fixed <- list(...)[["fixed"]] if(!is.null(fixed)) thetaFree <- theta[!fixed] else thetaFree <- theta ## obj<-f(thetaFree, ...) r<-R(thetaFree,thetaFree,...) for(i in 1L:outer.iterations){ obj.old<-obj r.old<-r thetaFree.old<-thetaFree fun<-function(thetaFree,...){ R(thetaFree,thetaFree.old,...)} if( method == "SANN" ) { if( is.null( grad ) ) { gradient <- NULL } else { gradient <- grad } } else { gradient <- function(thetaFree, ...) { dR(thetaFree, thetaFree.old, ...) } } ## As 'optim' does not directly support fixed parameters, a<-optim(par=thetaFree.old,fn=fun,gr=gradient,control=control,method=method,...) r<-a$value if (is.finite(r) && is.finite(r.old) && abs(r-r.old)/(outer.eps+abs(r-r.old))obj.old) break } if (i==outer.iterations){ a$convergence<-7 a$message<-"Barrier algorithm ran out of iterations and did not converge" } if (mu>0 && obj>obj.old){ a$convergence<-11 a$message<-paste("Objective function increased at outer iteration",i) } if (mu<0 && obj (eigentol*max(hessev))) { ## If hessian is not singular, fill in the free parameter values varcovar[activePar,activePar] <- solve(-hessian(object)[activePar,activePar]) # guarantee that the returned variance covariance matrix is symmetric varcovar <- ( varcovar + t( varcovar ) ) / 2 } else { ## If singular, the free parameter values will be Inf varcovar[activePar,activePar] <- Inf } return(varcovar) } else return(NULL) } maxLik/R/bread.maxLik.R0000644000176200001440000000011311374254264014327 0ustar liggesusersbread.maxLik <- function( x, ... ) { return( vcov( x ) * nObs( x ) ) } maxLik/R/numericHessian.R0000644000176200001440000000543711724727024015017 0ustar liggesusersnumericHessian <- function(f, grad=NULL, t0, eps=1e-6, fixed, ...) { a <- f(t0, ...) if(is.null(grad)) { numericNHessian( f = f, t0 = t0, eps = eps, fixed=fixed, ...) # gradient not provided -> everything numerically } else { numericGradient( f = grad, t0 = t0, eps = eps, fixed=fixed, ...) # gradient is provided -> Hessian is grad grad } } numericNHessian <- function( f, t0, eps=1e-6, fixed, ...) { ## Numeric Hessian without gradient ## Assume f() returns a scalar ## ## fixed calculate the Hessian only for the non-fixed parameters warnMessage <- function(theta, value) { ## issue a warning if the function value at theta is not a scalar max.print <- 10 if(length(value) != 1) { warnMsg <- "Function value at\n" warnMsg <- c(warnMsg, paste(format(theta[seq(length=min(max.print,length(theta)))]), collapse=" "), "\n") if(max.print < length(theta)) warnMsg <- c(warnMsg, "...\n") warnMsg <- c(warnMsg, " =\n") warnMsg <- c(warnMsg, paste(format(value[seq(length=min(max.print,length(value)))]), collapse=" "), "\n") if(max.print < length(value)) warnMsg <- c(warnMsg, "...\n") warnMsg <- c(warnMsg, "but numeric Hessian only works on numeric scalars\n", "Component set to NA") return(warnMsg) } if(!is.numeric(value)) stop("The function value must be numeric") return(NULL) } f00 <- f( t0, ...) if(!is.null(msg <- warnMessage(t0, f00))) { warning(msg) f00 <- NA } eps2 <- eps*eps N <- length( t0) H <- matrix(NA, N, N) if(missing(fixed)) fixed <- rep(FALSE, length(t0)) for( i in 1:N) { if(fixed[i]) next for( j in 1:N) { if(fixed[j]) next t01 <- t0 t10 <- t0 t11 <- t0 # initial point t01[i] <- t01[i] + eps t10[j] <- t10[j] + eps t11[i] <- t11[i] + eps t11[j] <- t11[j] + eps f01 <- f( t01, ...) if(!is.null(msg <- warnMessage(t01, f01))) { warning(msg) f01 <- NA } f10 <- f( t10, ...) if(!is.null(msg <- warnMessage(t10, f10))) { warning(msg) f10 <- NA } f11 <- f( t11, ...) if(!is.null(msg <- warnMessage(t11, f11))) { warning(msg) f11 <- NA } H[i,j] <- ( f11 - f01 - f10 + f00)/eps2 } } return( H ) } maxLik/R/stdEr.maxLik.R0000644000176200001440000000077412660344410014340 0ustar liggesusers stdEr.maxLik <- function(x, eigentol=1e-12, ...) { ## if(!inherits(x, "maxLik")) ## stop("'stdEr.maxLik' called on a non-'maxLik' object") ## Here we should actually coerce the object to a 'maxLik' object, dropping all the subclasses... ## Instead, we force the program to use maxLik-related methods if(!is.null(vc <- vcov(x, eigentol=eigentol))) { s <- sqrt(diag(vc)) names(s) <- names(coef(x)) return(s) } # if vcov is not working, return NULL return(NULL) } maxLik/R/summary.maxLik.R0000644000176200001440000000611513105610400014735 0ustar liggesusersprint.summary.maxLik <- function( x, digits = max( 3L, getOption("digits") - 3L ), ... ) { cat("--------------------------------------------\n") cat("Maximum Likelihood estimation\n") cat(maximType(x), ", ", nIter(x), " iterations\n", sep="") cat("Return code ", returnCode(x), ": ", returnMessage(x), "\n", sep="") if(!is.null(x$estimate)) { cat("Log-Likelihood:", x$loglik, "\n") cat(x$NActivePar, " free parameters\n") cat("Estimates:\n") printCoefmat( x$estimate, digits = digits ) } if(!is.null(x$constraints)) { cat("\nWarning: constrained likelihood estimation.", "Inference is probably wrong\n") cat("Constrained optimization based on", x$constraints$type, "\n") if(!is.null(x$constraints$code)) cat("Return code:", x$constraints$code, "\n") # note: this is missing for 'constrOptim' if(!is.null(x$constraints$message)) cat(x$constraints$message, "\n") # note: this is missing for 'constrOptim' cat(x$constraints$outer.iterations, " outer iterations, barrier value", x$constraints$barrier.value, "\n") } cat("--------------------------------------------\n") } summary.maxLik <- function(object, eigentol=1e-12,... ) { ## object object of class "maxLik" ## ## RESULTS: ## list of class "summary.maxLik" with following components: ## maximum : function value at optimum ## estimate : estimated parameter values at optimum ## gradient : gradient at optimum ## code : code of convergence ## message : message, description of the code ## iterations : number of iterations ## type : type of optimisation ## if(!inherits(object, "maxLik")) stop("'summary.maxLik' called on a non-'maxLik' object") ## Here we should actually coerce the object to a 'maxLik' object, dropping all the subclasses... ## Instead, we force the program to use maxLik-related methods result <- object$maxim nParam <- length(coef.maxLik(object)) activePar <- activePar( object ) if((object$code < 100) & !is.null(coef.maxLik(object))) { # in case of infinity at initial values, the coefs are not provided t <- coef( object ) / stdEr( object, eigentol = eigentol ) p <- 2*pnorm( -abs( t)) t[!activePar(object)] <- NA p[!activePar(object)] <- NA results <- cbind("Estimate" = coef( object ), "Std. error" = stdEr( object, eigentol = eigentol ), "t value" = t, "Pr(> t)" = p ) } else { results <- NULL } summary <- list(maximType=object$type, iterations=object$iterations, returnCode=object$code, returnMessage=object$message, loglik=object$maximum, estimate=results, fixed=!activePar, NActivePar=sum(activePar), constraints=object$constraints) class(summary) <- "summary.maxLik" summary } maxLik/R/compareDerivatives.R0000644000176200001440000000566711723217261015677 0ustar liggesuserscompareDerivatives <- function(f, grad, hess=NULL, t0, eps=1e-6, print=TRUE, ...) { ### t0 - initial parameter vector ## ## 1. Initial function and grad eval ## if(print)cat("-------- compare derivatives -------- \n") f0 <- f(t0, ...) attributes(f0) <- NULL # keep only array data when printing if(is.function(grad)) analytic <- grad(t0, ...) else if(is.numeric(grad)) analytic = grad else stop("Argument 'grad' must be either gradient function or ", "pre-computed numeric gradient matrix") out <- list(t0=t0, f.t0=f0, compareGrad = list(analytic=analytic)) # if(is.null(dim(analytic))) { if(print)cat("Note: analytic gradient is vector. ", "Transforming into a matrix form\n") if(length(f0) > 1) analytic <- matrix(analytic, length(analytic), 1) # Note: we assume t0 is a simple vector -> hence gradient # will be a column vector else analytic <- matrix(analytic, 1, length(analytic)) # f returns a scalar -> we have row vector along t0 } if(print) { cat("Function value:\n") print(f0) } if(print)cat("Dim of analytic gradient:", dim(analytic), "\n") numeric <- numericGradient(f, t0, eps, ...) out$compareGrad$numeric = numeric if(print)cat(" numeric :", dim(numeric), "\n") # rDiff <- (analytic - numeric)/analytic rDiff <- ((analytic - numeric) / (0.5*(abs(analytic) + abs(numeric))) ) rDiff[(analytic==0) & (numeric==0)] <- 0 rDiff. <- max(abs(rDiff), na.rm=TRUE) out$compareGrad$rel.diff <- rDiff out$maxRelDiffGrad <- rDiff. # if(print){ if(ncol(analytic) < 2) { a <- cbind(t0, analytic, numeric, rDiff) dimnames(a) <- list(param=names(f0), c("theta 0", "analytic", "numeric", "rel.diff")) print(a) } else { cat("t0\n") print(t0) cat("analytic gradient\n") print(analytic) cat("numeric gradient\n") print(numeric) cat(paste("(anal-num)/(0.5*(abs(anal)+abs(num)))\n")) print(rDiff) a=list(t0=t0, analytic=analytic, numeric=numeric, rel.diff=rDiff) } cat("Max relative difference:", rDiff., "\n") } # out <- list(t0=t0, f.t0=f0, compareGrad=a, maxRelDiffGrad=rDiff.) ## ## Hessian? ## if(!is.null(hess)) { if(print)cat("Comparing hessians: relative dfference\n") anHess <- hess(t0, ...) numHess <- numericGradient(grad, t0, eps, ...) rDifHess <- ((anHess-numHess) / (0.5*(abs(anHess)+abs(numHess))) ) rDifHess[(anHess==0) & (numHess==0)] <- 0 rDifHess. <- max(abs(rDifHess), na.rm=TRUE) if(print)print(rDifHess.) out$compareHessian <- list(analytic = anHess, numeric = numHess, rel.diff = rDifHess) out$maxRelDiffHess = rDifHess. } if(print)cat("-------- END of compare derivatives -------- \n") invisible(out) } maxLik/R/activePar.R0000644000176200001440000000061511414357723013752 0ustar liggesusers## activePar: returns parameters which are free under maximisation (not fixed as constants) activePar <- function(x, ...) UseMethod("activePar") activePar.default <- function(x, ...) { if( !is.null( x$fixed ) ) { result <- !x$fixed } else { result <- x$activePar } if( is.null( result ) ) { result <- rep( TRUE, length( coef( x ) ) ) } return( result ) } maxLik/R/AIC.R0000644000176200001440000000021211064412146012411 0ustar liggesusers## Akaike (and other) information criteria AIC.maxLik <- function(object, ..., k = 2) -2*logLik(object) + k*nParam(object, free=TRUE) maxLik/R/checkBhhhGrad.R0000644000176200001440000000645411723217261014503 0ustar liggesuserscheckBhhhGrad <- function( g, theta, analytic, fixed=NULL) { ## This function controls if the user-supplied analytic or ## numeric gradient of the right dimension. ## If not, signals an error. ## ## analytic: logical, do we have a user-supplied analytic ## gradient? if(is.null(fixed)) { activePar <- rep(T, length=length(theta)) } else { activePar <- !fixed } if( analytic ) { ## Gradient supplied by the user. ## Check whether the gradient has enough rows (about enough ## observations in data) if( !is.matrix( g ) ) { stop("gradient is not a matrix but of class '", class( g ), "';\n", "the BHHH method requires that the gradient function\n", "(argument 'grad') returns a numeric matrix,\n", "where each row must correspond to the gradient(s)\n", "of the log-likelihood function at an individual\n", "(independent) observation and each column must\n", "correspond to a parameter" ) } else if( nrow( g ) < length( theta[activePar] ) ) { stop( "the matrix returned by the gradient function", " (argument 'grad') must have at least as many", " rows as the number of parameters (", length( theta ), "),", " where each row must correspond to the gradients", " of the log-likelihood function of an individual", " (independent) observation:\n", " currently, there are (is) ", length( theta ), " parameter(s)", " but the gradient matrix has only ", nrow( g ), " row(s)" ) } else if( ncol( g ) != length( theta ) ) { stop( "the matrix returned by the gradient function", " (argument 'grad') must have exactly as many columns", " as the number of parameters:\n", " currently, there are (is) ", length( theta ), " parameter(s)", " but the gradient matrix has ", ncol( g ), " columns" ) } } else { ## numeric gradient ## Check whether the gradient has enough rows. This is the case ## if and only if loglik has enough rows, hence the error message ## about loglik. if( !is.matrix( g ) || nrow( g ) == 1 ) { stop( "if the gradients (argument 'grad') are not provided by the user,", " the BHHH method requires that the log-likelihood function", " (argument 'fn') returns a numeric vector,", " where each element must be the log-likelihood value corresponding", " to an individual (independent) observation" ) } if( nrow( g ) < length( theta ) ) { stop( "the vector returned by the log-likelihood function", " (argument 'fn') must have at least as many elements", " as the number of parameters,", " where each element must be the log-likelihood value corresponding", " to an individual (independent) observation:\n", " currently, there are (is) ", length( theta ), " parameter(s)", " but the log likelihood function return only ", nrow( g ), " element(s)" ) } } return( NULL ) } maxLik/R/hessian.R0000644000176200001440000000021010737143307013453 0ustar liggesusers## Return Hessian of an object hessian <- function(x, ...) UseMethod("hessian") hessian.default <- function(x, ...) x$hessian maxLik/R/maxBHHH.R0000644000176200001440000000155212573147301013250 0ustar liggesusersmaxBHHH <- function(fn, grad=NULL, hess=NULL, start, finalHessian="BHHH", ...) { ## hess: Hessian, not used, for compatibility with the other methods ## check if arguments of user-provided functions have reserved names argNames <- c( "fn", "grad", "hess", "start", "print.level", "iterlim" ) checkFuncArgs( fn, argNames, "fn", "maxBHHH" ) if( !is.null( grad ) ) { checkFuncArgs( grad, argNames, "grad", "maxBHHH" ) } if( !is.null( hess ) ) { checkFuncArgs( hess, argNames, "hess", "maxBHHH" ) } ## using the Newton-Raphson algorithm with BHHH method for Hessian a <- maxNR( fn=fn, grad = grad, hess = hess, start=start, finalHessian = finalHessian, bhhhHessian = TRUE, ...) a$type = "BHHH maximisation" invisible(a) } maxLik/R/returnMessage.R0000644000176200001440000000036011225431716014650 0ustar liggesusers returnMessage <- function(x, ...) UseMethod("returnMessage") returnMessage.default <- function(x, ...) x$returnMessage returnMessage.maxim <- function(x, ...) x$message returnMessage.maxLik <- function(x, ...) x$message maxLik/R/openParam.R0000644000176200001440000000125112603112024013733 0ustar liggesusersopenParam <- function(object) { ## Return character list of 'open parameters', parameters that can ## be supplied to max* outside of 'control' list ## if(!inherits(object, "MaxControl")) { stop("'MaxControl' object required. Currently ", class(object)) } c("tol", "reltol", "gradtol", "steptol", # "lambdatol", ## Qadratic Approximation Control "qac", "qrtol", "lambda0", "lambdaStep", "maxLambda", ## optim Nelder-Mead "alpha", "beta", "gamma", ## SANN (open versions) "cand", "temp", "tmax", "random.seed", ## "iterlim", "printLevel", "print.level") } maxLik/R/returnCode.R0000644000176200001440000000030610737143307014141 0ustar liggesusers## Returns return (error) code returnCode <- function(x, ...) UseMethod("returnCode") returnCode.default <- function(x, ...) x$returnCode returnCode.maxLik <- function(x, ...) x$code maxLik/R/callWithoutSumt.R0000644000176200001440000000032411355554676015213 0ustar liggesusers## strip possible SUMT parameters and call the function thereafter callWithoutSumt <- function(theta, fName, ...) { return( callWithoutArgs( theta, fName = fName, args = names(formals(sumt)), ... ) ) } maxLik/R/maximType.R0000644000176200001440000000022111176611424013776 0ustar liggesusersmaximType <- function(x) UseMethod("maximType") maximType.default <- function(x) x$maximType maximType.maxim <- function(x) x$type maxLik/R/logLikHess.R0000644000176200001440000000357011415061135014071 0ustar liggesusers## Calculate the Hessian of the function, either by analytic or numeric method logLikHess <- function( theta, fnOrig, gradOrig, hessOrig, start = NULL, fixed = NULL, gradAttr = NULL, hessAttr = NULL, ... ) { # argument "gradAttr" should be # - FALSE if the gradient is not provided as attribute of the log-lik value # - TRUE if the gradient is provided as attribute of the log-lik value # - NULL if this is not known # argument "hessAttr" should be # - FALSE if the Hessian is not provided as attribute of the log-lik value # - TRUE if the Hessian is provided as attribute of the log-lik value # - NULL if this is not known theta <- addFixedPar( theta = theta, start = start, fixed = fixed, ...) if(!is.null(hessOrig)) { hessian <- as.matrix(hessOrig( theta, ... )) } else { if( is.null( hessAttr ) || hessAttr || is.null( gradAttr ) ) { llVal <- fnOrig( theta, ... ) gradient <- attr( llVal, "gradient" ) hessian <- attr( llVal, "hessian" ) gradAttr <- !is.null( gradient ) hessAttr <- !is.null( hessian ) } if( !hessAttr ) { if( !is.null( gradOrig ) ) { grad2 <- logLikGrad } else if( gradAttr ) { grad2 <- function( theta, fnOrig = NULL, gradOrig = NULL, ... ) { gradient <- attr( fnOrig( theta, ... ), "gradient" ) gradient <- sumGradients( gradient, length( theta ) ) return( gradient ) } } else { grad2 <- NULL } hessian <- numericHessian( f = logLikFunc, grad = grad2, t0 = theta, fnOrig = fnOrig, gradOrig = gradOrig, ... ) } } rownames( hessian ) <- colnames( hessian ) <- names( theta ) if( !is.null( fixed ) ) { hessian <- hessian[ !fixed, !fixed, drop = FALSE ] } return( hessian ) } maxLik/R/objectiveFn.R0000644000176200001440000000025712660520442014266 0ustar liggesusers## Return the objective function, used for optimization objectiveFn <- function(x, ...) UseMethod("objectiveFn") objectiveFn.maxim <- function(x, ...) x$objectiveFn maxLik/R/maxBFGSRCompute.R0000644000176200001440000003451512601127106014735 0ustar liggesusersmaxBFGSRCompute <- function(fn, start, finalHessian=TRUE, fixed=NULL, control=maxControl(), ...) { ## This function is originally developed by Yves Croissant (and placed in 'mlogit' package). ## Fitted for 'maxLik' by Ott Toomet, and revised by Arne Henningsen ## ## BFGS maximisation, implemented by Yves Croissant ## Parameters: ## fn - the function to be minimized. Returns either scalar or ## vector value with possible attributes ## constPar and newVal ## fn must return the value with attribute 'gradient' ## (and also attribute 'hessian' if it should be returned) ## fn must have an argument sumObs ## start - initial parameter vector (eventually w/names) ## finalHessian include final Hessian? As computing final hessian does not carry any extra penalty for NR method, this option is ## mostly for compatibility reasons with other maxXXX functions. ## TRUE/something else include ## FALSE do not include ## fixed - a logical vector -- which parameters are taken as fixed. ## control MaxControl object: ## steptol - minimum step size ## lambdatol - max lowest eigenvalue when forcing pos. definite H ## qrtol - tolerance for qr decomposition ## qac How to handle the case where new function value is ## smaller than the original one: ## "stephalving" smaller step in the same direction ## "marquardt" Marquardt (1963) approach ## The stopping criteria ## tol - maximum allowed absolute difference between sequential values ## reltol - maximum allowed reltive difference (stops if < reltol*(abs(fn) + reltol) ## gradtol - maximum allowed norm of gradient vector ## ## iterlim - maximum # of iterations ## ## Other paramters are treated as variable (free). ## ## RESULTS: ## a list of class "maxim": ## maximum function value at maximum ## estimate the parameter value at maximum ## gradient gradient ## hessian Hessian ## code integer code of success: ## 1 - gradient close to zero ## 2 - successive values within tolerance limit ## 3 - could not find a higher point (step error) ## 4 - iteration limit exceeded ## 100 - initial value out of range ## message character message describing the code ## last.step only present if code == 3 (step error). A list with following components: ## theta0 - parameter value which led to the error ## f0 - function value at these parameter values ## climb - the difference between theta0 and the new approximated parameter value (theta1) ## fixed - logical vector, which parameters are constant (fixed, inactive, non-free) ## fixed logical vector, which parameters were treated as constant (fixed, inactive, non-free) ## iterations number of iterations ## type "BFGSR maximisation" ## ## max.eigen <- function( M) { ## return maximal eigenvalue of (symmetric) matrix val <- eigen(M, symmetric=TRUE, only.values=TRUE)$values val[1] ## L - eigenvalues in decreasing order, [1] - biggest in abs value } ## maxim.type <- "BFGSR maximization" param <- start nimed <- names(start) nParam <- length(param) ## chi2 <- 1E+10 iter <- 0 # eval a first time the function, the gradient and the hessian x <- sumKeepAttr( fn( param, fixed = fixed, sumObs = FALSE, returnHessian = FALSE, ... ) ) # sum of log-likelihood value but not sum of gradients if (slot(control, "printLevel") > 0) cat( "Initial value of the function :", x, "\n" ) if(is.na(x)) { result <- list(code=100, message=maximMessage("100"), iterations=0, type=maxim.type) class(result) <- "maxim" return(result) } if(is.infinite(x) & (x > 0)) { # we stop at +Inf but not at -Inf result <- list(code=5, message=maximMessage("5"), iterations=0, type=maxim.type) class(result) <- "maxim" return(result) } if( isTRUE( attr( x, "gradBoth" ) ) ) { warning( "the gradient is provided both as attribute 'gradient' and", " as argument 'grad': ignoring argument 'grad'" ) } if( isTRUE( attr( x, "hessBoth" ) ) ) { warning( "the Hessian is provided both as attribute 'hessian' and", " as argument 'hess': ignoring argument 'hess'" ) } ## ## gradient by individual observations, used for BHHH approximation of initial Hessian. ## If not supplied by observations, we use the summed gradient. gri <- attr( x, "gradient" ) gr <- sumGradients( gri, nParam = length( param ) ) if(slot(control, "printLevel") > 2) { cat("Initial gradient value:\n") print(gr) } if(any(is.na(gr[!fixed]))) { stop("NA in the initial gradient") } if(any(is.infinite(gr[!fixed]))) { stop("Infinite initial gradient") } if(length(gr) != nParam) { stop( "length of gradient (", length(gr), ") not equal to the no. of parameters (", nParam, ")" ) } ## initial approximation for inverse Hessian. We only work with the non-fixed part if(observationGradient(gri, length(param))) { invHess <- -solve(crossprod(gri[,!fixed])) # initial approximation of inverse Hessian (as in BHHH), if possible if(slot(control, "printLevel") > 3) { cat("Initial inverse Hessian by gradient crossproduct\n") if(slot(control, "printLevel") > 4) { print(invHess) } } } else { invHess <- -1e-5*diag(1, nrow=length(gr[!fixed])) # ... if not possible (Is this OK?). Note we make this negative definite. if(slot(control, "printLevel") > 3) { cat("Initial inverse Hessian is diagonal\n") if(slot(control, "printLevel") > 4) { print(invHess) } } } if( slot(control, "printLevel") > 1) { cat("-------- Initial parameters: -------\n") cat( "fcn value:", as.vector(x), "\n") a <- cbind(start, gr, as.integer(!fixed)) dimnames(a) <- list(nimed, c("parameter", "initial gradient", "free")) print(a) cat("------------------------------------\n") } samm <- NULL # this will be returned in case of step getting too small I <- diag(nParam - sum(fixed)) direction <- rep(0, nParam) ## ----------- Main loop --------------- repeat { iter <- iter + 1 if( iter > slot(control, "iterlim")) { code <- 4; break } if(any(is.na(invHess))) { cat("Error in the approximated (free) inverse Hessian:\n") print(invHess) stop("NA in Hessian") } if(slot(control, "printLevel") > 0) { cat("Iteration ", iter, "\n") if(slot(control, "printLevel") > 3) { cat("Eigenvalues of approximated inverse Hessian:\n") print(eigen(invHess, only.values=TRUE)$values) if(slot(control, "printLevel") > 4) { cat("inverse Hessian:\n") print(invHess) } } } ## Next, ensure that the approximated inverse Hessian is negative definite for computing ## the new climbing direction. However, retain the original, potentially not negative definite ## for computing the following approximation. ## This procedure seems to work, but unfortunately I have little idea what I am doing :-( approxHess <- invHess # approxHess is used for computing climbing direction, invHess for next approximation while((me <- max.eigen( approxHess)) >= -slot(control, "lambdatol") | (qRank <- qr(approxHess, tol=slot(control, "qrtol"))$rank) < sum(!fixed)) { # maximum eigenvalue -> negative definite # qr()$rank -> singularity lambda <- abs(me) + slot(control, "lambdatol") + min(abs(diag(approxHess)))/1e7 # The third term corrects numeric singularity. If diag(H) only contains # large values, (H - (a small number)*I) == H because of finite precision approxHess <- approxHess - lambda*I if(slot(control, "printLevel") > 4) { cat("Not negative definite. Subtracting", lambda, "* I\n") cat("Eigenvalues of new approximation:\n") print(eigen(approxHess, only.values=TRUE)$values) if(slot(control, "printLevel") > 5) { cat("new Hessian approximation:\n") print(approxHess) } } # how to make it better? } ## next, take a step of suitable length to the suggested direction step <- 1 direction[!fixed] <- as.vector(approxHess %*% gr[!fixed]) oldx <- x oldgr <- gr oldparam <- param param[!fixed] <- oldparam[!fixed] - step * direction[!fixed] x <- sumKeepAttr( fn( param, fixed = fixed, sumObs = FALSE, returnHessian = FALSE, ... ) ) # sum of log-likelihood value but not sum of gradients ## did we end up with a larger value? while((is.na(x) | x < oldx) & step > slot(control, "steptol")) { step <- step/2 if(slot(control, "printLevel") > 2) { cat("Function decreased. Function values: old ", oldx, ", new ", x, ", difference ", x - oldx, "\n") if(slot(control, "printLevel") > 3) { resdet <- cbind(param = param, gradient = gr, direction=direction, active=!fixed) cat("Attempted parameters:\n") print(resdet) } cat(" -> step ", step, "\n", sep="") } param[!fixed] <- oldparam[!fixed] - step * direction[!fixed] x <- sumKeepAttr( fn( param, fixed = fixed, sumObs = FALSE, returnHessian = FALSE, ... ) ) # sum of log-likelihood value but not sum of gradients } if(step < slot(control, "steptol")) { # we did not find a better place to go... samm <- list(theta0=oldparam, f0=oldx, climb=direction) } gri <- attr( x, "gradient" ) # observation-wise gradient. We only need it in order to compute the BHHH Hessian, if asked so. gr <- sumGradients( gri, nParam = length( param ) ) incr <- step * direction y <- gr - oldgr if(all(y == 0)) { # gradient did not change -> cannot proceed code <- 9; break } ## Compute new approximation for the inverse hessian update <- outer( incr[!fixed], incr[!fixed]) * (sum(y[!fixed] * incr[!fixed]) + as.vector( t(y[!fixed]) %*% invHess %*% y[!fixed])) / sum(incr[!fixed] * y[!fixed])^2 + (invHess %*% outer(y[!fixed], incr[!fixed]) + outer(incr[!fixed], y[!fixed]) %*% invHess)/ sum(incr[!fixed] * y[!fixed]) invHess <- invHess - update ## chi2 <- - crossprod(direction[!fixed], oldgr[!fixed]) if (slot(control, "printLevel") > 0){ cat("step = ",step, ", lnL = ", x,", chi2 = ", chi2, ", function increment = ", x - oldx, "\n",sep="") if (slot(control, "printLevel") > 1){ resdet <- cbind(param = param, gradient = gr, direction=direction, active=!fixed) print(resdet) cat("--------------------------------------------\n") } } if( step < slot(control, "steptol")) { code <- 3; break } if( sqrt( crossprod( gr[!fixed] ) ) < slot(control, "gradtol") ) { code <-1; break } if(x - oldx < slot(control, "tol")) { code <- 2; break } if(x - oldx < slot(control, "reltol")*(x + slot(control, "reltol"))) { code <- 8; break } if(is.infinite(x) & x > 0) { code <- 5; break } } if( slot(control, "printLevel") > 0) { cat( "--------------\n") cat( maximMessage( code), "\n") cat( iter, " iterations\n") cat( "estimate:", param, "\n") cat( "Function value:", x, "\n") } if( is.matrix( gr ) ) { if( dim( gr )[ 1 ] == 1 ) { gr <- gr[ 1, ] } } names(gr) <- names(param) # calculate (final) Hessian if(tolower(finalHessian) == "bhhh") { if(observationGradient(gri, length(param))) { hessian <- - crossprod( gri ) attr(hessian, "type") <- "BHHH" } else { hessian <- NULL warning("For computing the final Hessian by 'BHHH' method, the log-likelihood or gradient must be supplied by observations") } } else if(finalHessian) { hessian <- attr( fn( param, fixed = fixed, returnHessian = TRUE, ... ) , "hessian" ) } else { hessian <- NULL } if( !is.null( hessian ) ) { rownames( hessian ) <- colnames( hessian ) <- nimed } ## remove attributes from final value of objective (likelihood) function attributes( x )$gradient <- NULL attributes( x )$hessian <- NULL attributes( x )$gradBoth <- NULL attributes( x )$hessBoth <- NULL ## result <-list( maximum = unname( drop( x ) ), estimate=param, gradient=gr, hessian=hessian, code=code, message=maximMessage( code), last.step=samm, # only when could not find a # lower point fixed=fixed, iterations=iter, type=maxim.type) if(observationGradient(gri, length(param))) { colnames( gri ) <- names( param ) result$gradientObs <- gri } result <- c(result, control=control) # attach the control parameters class(result) <- c("maxim", class(result)) invisible(result) } maxLik/R/checkFuncArgs.R0000644000176200001440000000215011256177761014544 0ustar liggesuserscheckFuncArgs <- function( func, checkArgs, argName, funcName ) { ## is the 'func' a function? if( !is.function( func ) ) { stop( "argument '", argName, "' of function '", funcName, "' is not a function" ) } funcArgs <- names( formals( func ) ) if( length( funcArgs ) > 1 ) { a <- charmatch( funcArgs[ -1 ], checkArgs ) if( sum( !is.na( a ) ) == 1 ) { stop( "argument '", funcArgs[ -1 ][ !is.na( a ) ], "' of the function specified in argument '", argName, "' of function '", funcName, "' (partially) matches the argument names of function '", funcName, "'. Please change the name of this argument" ) } else if( sum( !is.na( a ) ) > 1 ) { stop( "arguments '", paste( funcArgs[ -1 ][ !is.na( a ) ], collapse = "', '" ), "' of the function specified in argument '", argName, "' of function '", funcName, "' (partially) match the argument names of function '", funcName, "'. Please change the names of these arguments" ) } } return( NULL ) } maxLik/MD50000644000176200001440000001241113606005761012012 0ustar liggesusers617a34344d05920056b9792d893cd32d *DESCRIPTION 1a85293aa0f04e1e05c71808e0d0dd2c *NAMESPACE b4120c1af64cfd75937161d4b1debd99 *NEWS 07512e0403e60dbe4c310f66880b4fb0 *R/05-classes.R 6c08c9f4de9848eea7c1969e76dec023 *R/10-MaxControl_class.R a9f1662e6dabd302ab25fafb6fead56c *R/20-maxControl.R d4c2d44f1ec7df3a83e484b0093f19a6 *R/25-addControlList.R c9fb3202482b0af04107c3fdb25cbdce *R/30-addControlDddot.R 23151b49bc8cdafc5378098818605dc8 *R/AIC.R 616d4b76bd50cdff58e1b31249581c2a *R/activePar.R 6b999dafa9bdf5880be41146752383ae *R/addFixedPar.R 1cb94fb786cf735b89302987f2f45ece *R/bread.maxLik.R 628fd12f511412a5431211ebc242b33b *R/callWithoutArgs.R b281b27bd439a07982fc1363b2c95e44 *R/callWithoutSumt.R f6b11464c98bd3662e2b4aae72410ee9 *R/checkBhhhGrad.R 907220a64644066e025e07d1dba550cd *R/checkFuncArgs.R 7446aa5174844bfb8b0c530d4b0292da *R/coef.maxLik.R 504f651d540bb6d84a03b60529730cdf *R/compareDerivatives.R f3c12fa85c5c5fb1f6e4b9ca564536b1 *R/condiNumber.R 16ce669188a2349f588a121fc48f85b9 *R/constrOptim2.R 804efa9a9611766159532fa1ba2535b7 *R/estfun.maxLik.R 1d0a677cc7248ab9651c2bec1d3316d6 *R/fnSubset.R 6e5949a08cd1c2b930d6ebf0037828d3 *R/gradient.R 64d17ba17bea697ac45de7f5ec616c47 *R/hessian.R 21446ccb89769a76daad63220a2f2640 *R/logLik.maxLik.R 4053c4794aee7d86f1100aa68b8b5ffd *R/logLikAttr.R 17dda617a86a0248d9aa8e80af6d3181 *R/logLikFunc.R 53af305a147d63a6a6125f9df1b30c7b *R/logLikGrad.R 6f5bb5dffae2175ef4b1e408283a024d *R/logLikHess.R 4a93edf08f36c69063511a11c81f4a05 *R/maxBFGS.R 002a26be9f64bbf092e7e33a1805a53c *R/maxBFGSR.R fc364bbff5c68827536c7827fcc997ad *R/maxBFGSRCompute.R fe5933fbf427415757cac7cccc7ed277 *R/maxBHHH.R dc26c765189aab53893ef20871587498 *R/maxCG.R fbd13bdfa6f2dc09a1a22bd6ee8569ba *R/maxLik.R b71d12473ef6a49f903b66a2aa2fb8b1 *R/maxNM.R 962f17ef6572a024e2bb64c32a0961bc *R/maxNR.R 906d610dbe6c992237302fdb6f937b50 *R/maxNRCompute.R af12951f1f661072362aa23df9a0b16a *R/maxOptim.R 63c770407939aefb4bfd99529cf92517 *R/maxSANN.R 64abe1be44c5c8f770fe8af7e2f57bca *R/maxValue.R 83523ce13d0157c4fabfc58ffc40786d *R/maximMessage.R 999df96b4d40ca70de26151b9f04d63e *R/maximType.R f4e22fe11b2dcb40e338b2f19dbfbde8 *R/nIter.R aa6c83d64ee8b14b3b5934fca4e1cf90 *R/nObs.R 1dc47c8109c34ff37a0c657d1cc82419 *R/nParam.R 76c96796242b1f29c693fff5946344d4 *R/numericGradient.R fd6764e2955ed5802e9d5c02dcc8cd17 *R/numericHessian.R 2f8dcbd5c37ed9702f45baed2bc79b7d *R/objectiveFn.R 32ee3ff9f876da5b606fea22ee11c3ce *R/observationGradient.R c11d56578c2e776790d6c767e354e003 *R/openParam.R 0db0a207aa820ecd499edc72f953ef1e *R/prepareFixed.R f681ec2a71708e712ea0c3841ecc9711 *R/print.maxLik.R 2d8c9fd7ddf91f986e7392c11d808397 *R/returnCode.R 69d1f09210d746bb394c6dd9bfa680bc *R/returnMessage.R 0ad6b3077e2e22603a12300892089655 *R/showMaxControl.R 39305dd91a5f62f3b5da99daee4bfa7f *R/stdEr.maxLik.R 131c1768155ac15fea7db3101dea58f5 *R/sumGradients.R b482c4c3a7a159b72916328d7ed1ef2a *R/summary.maxLik.R fcef0ef389f6eb9b0edbf08f815a1e3b *R/summary.maxim.R e6734c7b9e086764cd181d3213d668ce *R/sumt.R 7f8d32f62e006396f5dab695599f9037 *R/vcov.maxLik.R 75f63f7d6ab9ffae6a82540c17d5f57b *R/zzz.R 6bb1b8e24134c4322e0b6d50f3d87b6e *inst/CITATION 541b8bcdef939f3f175337f1c659e92e *man/activePar.Rd 370f5d012ecbf15249471ad2ba1df789 *man/bread.maxLik.Rd 89e72bbac14f3ce3047f642a8f16e64f *man/compareDerivatives.Rd 789962ea4222142cd8f51f51172c79ac *man/condiNumber.Rd 812c056426e615573fe71f21ca484374 *man/fnSubset.Rd 73e1ae1764c4ed51616a56de8275e42f *man/gradient.Rd 4cb76c1ed5f2dc2508d1010893089052 *man/hessian.Rd 0c14b964346dbc38fb5a13009bcbd85c *man/logLik.maxLik.Rd 7350eeb821cbb652f32ee3089fbe7514 *man/maxBFGS.Rd b6cec10908d5134f1fab1f6e78653cfe *man/maxControl.Rd d17ca1143a3ddb8e53a5df5172edf83d *man/maxLik-internal.Rd 0f5e2173869380fe0619e0363b63c923 *man/maxLik-methods.Rd 32ad16864491d8f2df031d55e8d61d19 *man/maxLik-package.Rd e9b9fd3dfe0aaf9dfecef15184979f06 *man/maxLik.Rd 98b634febfd16a0ba6db300d1a3ede1c *man/maxNR.Rd f76b141dc0d11b6e22d9391a1f82f905 *man/maxValue.Rd 35f8dbfb6a4aefdeede7ce8f3095f441 *man/maximType.Rd 22d3768a69246b071d441f4130db0a8a *man/nIter.Rd a74b0179e0c41a659aa1c359ba4ce082 *man/nObs.Rd 9619ae8a8492398dc9280cfe608a33e7 *man/nParam.Rd 3552f1fe651edc3af0638c1ec4493b1b *man/numericGradient.Rd 4bf4ed2639941e261d783a1625f9958e *man/objectiveFn.Rd 3ec6b741abbe7b2f64137fec677f2877 *man/returnCode.Rd a3a8386815b17bdc8bccaff37b2df549 *man/summary.maxLik.Rd aabf99d5d55ac733ab59d1ed00349dfc *man/summary.maxim.Rd e39688cb93ce2092adca8dcb79617203 *man/sumt.Rd c9832e82bd584e5837f81a676c5e877b *man/vcov.maxLik.Rd b2d527d3c65311cbb6e3e035a81b4268 *tests/BFGSR.R 7b1651cf9375022a41f4084af5270f70 *tests/BFGSR.Rout.save a2eb699a0ce54027990ce6a52dec6c5e *tests/basicTest.R 1a2cd942ba483c3255252fc639102bfd *tests/basicTest.Rout.save 29c954c33db65e9105745799a996cb8d *tests/constraints.R 76f00749d5657d785a124bb8df9d50e5 *tests/constraints.Rout.save 70db31a194f4a57154ea8d6ca822dc52 *tests/finalHessian.R 97b4ff0ed6cf6613eac6fbfc1fde0552 *tests/finalHessian.Rout.save 9c585c86fb7f17d291e6ae1beedf7176 *tests/fitNormalDist_privateTest.Rout.save 7c2dc01ae7b7e577ce6b13b51088ab17 *tests/methods.R c8e4cad1df8d02f9b96915813b3c40d1 *tests/methods.Rout.save c1bbe611737d8fb90e93a7bac3b1be7a *tests/numericGradient.R da073867a297c038b711fda70344d2b7 *tests/numericGradient.Rout.save d0f0867ef9edb2a8d2b9c7d4fc1c9366 *tests/parameters_privateTest.Rout.save maxLik/inst/0000755000176200001440000000000013603275533012463 5ustar liggesusersmaxLik/inst/CITATION0000644000176200001440000000150212215564152013612 0ustar liggesuserscitHeader("To cite package 'maxLik' in publications use:") citEntry( entry = "Article", title = "maxLik: A package for maximum likelihood estimation in {R}", author = personList( as.person( "Arne Henningsen" ), as.person( "Ott Toomet" ) ), journal = "Computational Statistics", year = "2011", volume = "26", number = "3", pages = "443-458", doi = "10.1007/s00180-010-0217-1", url = "http://dx.doi.org/10.1007/s00180-010-0217-1", textVersion = paste( "Arne Henningsen and Ott Toomet (2011).", "maxLik: A package for maximum likelihood estimation in R.", "Computational Statistics 26(3), 443-458.", "DOI 10.1007/s00180-010-0217-1." ) )