maxLik/0000755000176200001440000000000012620121240011465 5ustar liggesusersmaxLik/inst/0000755000176200001440000000000012603115317012453 5ustar liggesusersmaxLik/inst/CITATION0000644000176200001440000000150212603115317013606 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." ) ) maxLik/tests/0000755000176200001440000000000012620012042012626 5ustar liggesusersmaxLik/tests/fitGammaDist.R0000644000176200001440000001370312603115317015340 0ustar liggesusers## the idea and most commands were provided by Marco J. Maier, Institute for ## Statistics and Mathematics, Vienna University of Economics and Business library(maxLik) options(warn = -1, digits = 4 ) set.seed(5) some_data <- rgamma(1e4, shape = 5, scale = 2) # log-likelihood function(s) logLL <- function(x, X) # per observation for maxLik dgamma(x = X, shape = exp(x[1]), scale = exp(x[2]), log = TRUE) logLL_sum <- function(x, X) # negative sum for nlm() -sum(dgamma(x = X, shape = exp(x[1]), scale = exp(x[2]), log = TRUE)) sum(logLL(log(c(5,2)),some_data)) logLL_sum(log(c(5,2)),some_data) all.equal( sum(logLL(log(c(5,2)),some_data)), -logLL_sum(log(c(5,2)),some_data)) # gradient of log-likelihood function d_logLL <- function(x, X){ # analytic 1. derivatives cbind(shape=exp(x[1])*(-x[2]-psigamma(exp(x[1]),0)+log(X)), scale= X / exp(x[2]) - exp(x[1])) } d_logLLNum <- function(x, X){ numericGradient( logLL, x, X = X ) } colSums(d_logLL(log(c(5,2)),some_data)) colSums(d_logLLNum(log(c(5,2)),some_data)) all.equal( d_logLL(log(c(5,2)),some_data), d_logLLNum(log(c(5,2)),some_data), check.attributes=FALSE) # Hessian of log-likelihood function dd_logLL <- function(x, X){ # analytic 2. derivatives grad <- d_logLL( x, X ) hessian <- matrix(0, 2, 2) hessian[1,1] <- sum( grad[,1] - exp(x[1])^2 * psigamma(exp(x[1]), 1) ) hessian[2,2] <- - sum( X / exp(x[2]) ) hessian[cbind(c(2,1), c(1,2))] <- -exp(x[1]) * length(X) return(hessian) } dd_logLLNum <- function(x, X){ numericHessian( function(x,X) sum(logLL(x,X)), t0=x, X = X ) } dd_logLLNumGrad <- function(x, X){ numericHessian( function(x,X) sum(logLL(x,X)), grad = function(x,X) colSums(d_logLL(x,X)), x, X = X ) } dd_logLL(log(c(5,2)),some_data) dd_logLLNum(log(c(5,2)),some_data) all.equal(dd_logLL(log(c(5,2)),some_data), dd_logLLNum(log(c(5,2)),some_data)) dd_logLLNumGrad(log(c(5,2)),some_data) all.equal(dd_logLL(log(c(5,2)),some_data), dd_logLLNumGrad(log(c(5,2)),some_data), check.attributes=FALSE) # estimation with nlm() t_nlm <- system.time( r_nlm <- nlm(logLL_sum, c(0,0), X=some_data, hessian=TRUE) ) # estimation with nlm() and gradients logLL_grad <- function(x, X) { result <- logLL_sum( x, X ) attr( result, "gradient" ) <- - colSums( d_logLL( x, X ) ) return( result ) } t_nlmg <- system.time( r_nlmg <- nlm(logLL_grad, c(0,0), X=some_data, hessian=TRUE) ) # estimation with nlm() and gradients and Hessian logLL_hess <- function(x, X) { result <- logLL_sum( x, X ) attr( result, "gradient" ) <- - colSums( d_logLL( x, X ) ) attr( result, "hessian" ) <- - dd_logLL( x, X ) return( result ) } t_nlmgh <- system.time( r_nlmgh <- nlm(logLL_hess, c(0,0), X=some_data, hessian=TRUE) ) # estimation with optim() / BFGS t_bfgs <- system.time( r_bfgs <- optim(c(0,0), logLL_sum, X=some_data, method="BFGS", hessian=TRUE) ) # estimation with maxLik() / BFGS t_bfgsM <- system.time( r_bfgsM <- maxLik( logLL, start = c(0,0), method="BFGS", X=some_data ) ) # estimation with maxLik() / BFGS with gradients t_bfgsMg <- system.time( r_bfgsMg <- maxLik( logLL, d_logLL, start = c(0,0), method="BFGS", X=some_data ) ) # estimation with maxLik() / BHHH t_bhhh <- system.time( r_bhhh <- maxLik( logLL, start = c(0,0), method="BHHH", X=some_data ) ) # estimation with maxLik() / BHHH with gradients t_bhhhg <- system.time( r_bhhhg <- maxLik( logLL, d_logLL, start = c(0,0), method="BHHH", X=some_data ) ) # estimation with maxLik() / NR t_NRn <- system.time( r_NRn <- maxLik( logLL, start = c(0,0), method="NR", X=some_data ) ) # estimation with maxLik() / NR with gradients t_NRg <- system.time( r_NRg <- maxLik( logLL, d_logLL, start = c(0,0), method="NR", X=some_data ) ) # estimation with maxLik() / NR with gradients and Hessian t_NRgh <- system.time( r_NRgh <- maxLik( logLL, d_logLL, dd_logLL, start = c(0,0), method="NR", X=some_data ) ) # log likelihood values rbind(NLM=-r_nlm$minimum, NLM_grad=-r_nlmg$minimum, NLM_gradHess=-r_nlmgh$minimum, BFGS=-r_bfgs$value, maxLikBfgs = logLik( r_bfgsM ), maxLikBfgs_grad = logLik( r_bfgsMg ), BHHH = logLik( r_bhhh ), BHHH_grad = logLik( r_bhhhg ), NR_numeric= logLik( r_NRn ), NR_grad= logLik( r_NRg ), NR_gradHess= logLik( r_NRgh ) ) # estimated coefficients pp <- exp(rbind(NLM=r_nlm$estimate, NLM_grad=r_nlmg$estimate, NLM_gradHess=r_nlmgh$estimate, BFGS=r_bfgs$par, maxLikBfgs = coef( r_bfgsM ), maxLikBfgs_grad = coef( r_bfgsMg ), BHHH = coef( r_bhhh ), BHHH_grad = coef( r_bhhhg ), NR_numeric= coef( r_NRn ), NR_grad= coef( r_NRg ), NR_gradHess= coef( r_NRgh ) )) colnames(pp) <- c("shape_alpha", "scale_theta") pp # some Hessians -100*round(r_nlm$hessian/100,0) round(solve(r_nlm$hessian),5) -100*round(r_nlmg$hessian/100,0) round(solve(r_nlmg$hessian),5) -100*round(r_nlmgh$hessian/100,0) round(solve(r_nlmgh$hessian),5) -100*round(r_bfgs$hessian/100,0) round(solve(r_bfgs$hessian),5) 100*round(r_NRn$hessian/100,0) round(solve(-r_NRn$hessian),5) 100*round(r_NRg$hessian/100,0) round(solve(-r_NRg$hessian),5) # standard errors se <- exp(rbind(NLM=sqrt(diag( solve(r_nlm$hessian) )), NLM_grad=sqrt(diag( solve(r_nlmg$hessian) )), NLM_gradHess=sqrt(diag( solve(r_nlmgh$hessian) )), BFGS=sqrt(diag( solve(r_bfgs$hessian) )), maxLikBfgs = stdEr( r_bfgsM ), maxLikBfgs_grad = stdEr( r_bfgsMg ), BHHH = stdEr( r_bhhh ), BHHH_grad = stdEr( r_bhhhg ), NR_numeric= stdEr( r_NRn ), NR_grad= stdEr( r_NRg ), NR_gradHess= stdEr( r_NRgh ) )) colnames(se) <- c("shape_alpha", "scale_theta") se # execution times tt <- rbind(t_nlm, t_nlmg, t_nlmgh, t_bfgs, t_bfgsM, t_bfgsMg, t_bhhh, t_bhhhg, t_NRn, t_NRg, t_NRgh ) # tt maxLik/tests/examples.Rout.save0000644000176200001440000015422012604622303016271 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. > 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) > > printRounded <- function( x ) { + for( i in names( x ) ) { + cat ( "$", i, "\n", sep = "" ) + if( is.numeric( x[[i]] ) ) { + print( round( x[[i]], 3 ) ) + } else { + print( x[[i]] ) + } + cat( "\n" ) + } + cat( "attr(,\"class\")\n" ) + print( class( x ) ) + } > > # round gradients to increase reproducibility of the accuracy > roundGradients <- function( object ) { + object$gradient <- round( object$gradient, 3 ) + return( object ) + } > > ### activePar > # a simple two-dimensional exponential hat > f <- function(a) exp(-(a[1]-2)^2 - (a[2]-4)^2) > # > # maximize wrt. both parameters > free <- maxNR(f, start=1:2) > printRounded( free ) $maximum [1] 1 $estimate [1] 2 4 $gradient [1] 0 0 $hessian [,1] [,2] [1,] -2 0 [2,] 0 -2 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE FALSE $iterations [1] 7 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > free <- roundGradients( free ) > summary(free) # results should be close to (2,4) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 7 Return code: 1 gradient close to zero Function value: 1 Estimates: estimate gradient [1,] 2 0 [2,] 4 0 -------------------------------------------- > activePar(free) [1] TRUE TRUE > # allow only the second parameter to vary > cons <- maxNR(f, start=1:2, activePar=c(FALSE,TRUE)) > printRounded( cons ) $maximum [1] 0.368 $estimate [1] 1 4 $gradient [1] NA 0 $hessian [,1] [,2] [1,] NA NA [2,] NA -0.736 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] TRUE FALSE $iterations [1] 4 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > cons <- roundGradients( cons ) > summary(cons) # result should be around (1,4) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 4 Return code: 1 gradient close to zero Function value: 0.3679 Estimates: estimate gradient [1,] 1 NA [2,] 4 0 -------------------------------------------- > activePar(cons) [1] FALSE TRUE > # specify fixed par in different ways > cons2 <- maxNR(f, start=1:2, fixed=1) > all.equal( cons[-3], cons2[-3] ) [1] TRUE > cons3 <- maxNR(f, start=1:2, fixed=c(TRUE,FALSE)) > all.equal( cons[-3], cons3[-3] ) [1] TRUE > cons4 <- maxNR(f, start=c(a=1, b=2), fixed="a") > cons4 <- roundGradients( cons4 ) > print(summary(cons4)) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 4 Return code: 1 gradient close to zero Function value: 0.3679 Estimates: estimate gradient a 1 NA b 4 0 -------------------------------------------- > all.equal( cons, cons4 ) [1] "Component \"estimate\": names for current but not for target" [2] "Component \"gradient\": names for current but not for target" [3] "Component \"hessian\": Attributes: < Length mismatch: comparison on first 1 components >" [4] "Component \"fixed\": names for current but not for target" > > ### compareDerivatives > set.seed( 2 ) > ## A simple example with sin(x)' = cos(x) > f <- sin > compareDerivatives(f, cos, t0=1) -------- compare derivatives -------- Note: analytic gradient is vector. Transforming into a matrix form Function value: [1] 0.8415 Dim of analytic gradient: 1 1 numeric : 1 1 param theta 0 analytic numeric rel.diff [1,] 1 0.5403 0.5403 -5.13e-11 Max relative difference: 5.13e-11 -------- END of compare derivatives -------- > ## > ## Example of log-likelihood of normal density. Two-parameter > ## function. > x <- rnorm(100, 1, 2) # generate rnorm x > l <- function(b) sum(log(dnorm((x-b[1])/b[2])/b[2])) > # b[1] - mu, b[2] - sigma > gradl <- function(b) { + c(sum(x - b[1])/b[2]^2, + sum((x - b[1])^2/b[2]^3 - 1/b[2])) + } > compareDerivatives(l, gradl, t0=c(1,2)) -------- compare derivatives -------- Note: analytic gradient is vector. Transforming into a matrix form Function value: [1] -227.9 Dim of analytic gradient: 1 2 numeric : 1 2 t0 [1] 1 2 analytic gradient [,1] [,2] [1,] -1.535 16.68 numeric gradient [,1] [,2] [1,] -1.535 16.68 (anal-num)/(0.5*(abs(anal)+abs(num))) [,1] [,2] [1,] -1.989e-09 -2.089e-10 Max relative difference: 1.989e-09 -------- END of compare derivatives -------- > > > ### hessian > set.seed( 3 ) > # 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(1000) # sample from standard normal > ml <- maxLik(ll, start=c(1,1)) > # ignore eventual warnings "NaNs produced in: log(x)" > printRounded( ml ) $maximum [1] -497.6 $estimate [1] 0.006 0.998 $gradient [1] 0 0 $hessian [,1] [,2] [1,] -1005 0 [2,] 0 -2010 $code [1] 2 $message [1] "successive function values within tolerance limit" $last.step NULL $fixed [1] FALSE FALSE $iterations [1] 6 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxLik" "maxim" "list" > print( ml ) Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -497.6 (2 free parameter(s)) Estimate(s): 0.006397 0.9976 > summary(ml) # result should be close to c(0,1) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -497.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.0064 0.0316 0.2 0.84 [2,] 0.9976 0.0223 44.7 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > hessian(ml) # How the Hessian looks like [,1] [,2] [1,] -1005 0 [2,] 0 -2010 > sqrt(-solve(hessian(ml))) # Note: standard deviations are on the diagonal [,1] [,2] [1,] 0.03155 0.00000 [2,] 0.00000 0.02231 > print(stdEr(ml)) [1] 0.03155 0.02231 > # test vector of stdEr-s > # > # Now run the same example while fixing a[2] = 1 > mlf <- maxLik(ll, start=c(1,1), activePar=c(TRUE, FALSE)) > printRounded( mlf ) $maximum [1] -497.6 $estimate [1] 0.006 1.000 $gradient [1] 0 NA $hessian [,1] [,2] [1,] -1000 NA [2,] NA NA $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE TRUE $iterations [1] 3 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxLik" "maxim" "list" > print( mlf ) Maximum Likelihood estimation Newton-Raphson maximisation, 3 iterations Return code 1: gradient close to zero Log-Likelihood: -497.6 (1 free parameter(s)) Estimate(s): 0.006397 1 > summary(mlf) # first parameter close to 0, the second exactly 1.0 -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 3 iterations Return code 1: gradient close to zero Log-Likelihood: -497.6 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.0064 0.0316 0.2 0.84 [2,] 1.0000 0.0000 NA NA -------------------------------------------- > hessian(mlf) [,1] [,2] [1,] -1000 NA [2,] NA NA > # now invert only the free parameter part of the Hessian > sqrt(-solve(hessian(mlf)[activePar(mlf), activePar(mlf)])) [,1] [1,] 0.03162 > # gives the standard deviation for the mean > print(stdEr(mlf)) [1] 0.03162 0.00000 > # test standard errors with fixed par > > > ### maxBFGS > set.seed( 5 ) > # Maximum Likelihood estimation of the parameter of Poissonian distribution > n <- rpois(100, 3) > loglik <- function(l) n*log(l) - l - lfactorial(n) > # we use numeric gradient > a <- maxBFGS(loglik, start=1) > print( a[-3] ) $maximum [1] -199.2 $estimate [1] 3.19 $hessian [,1] [1,] -31.29 $code [1] 0 $message [1] "successful convergence " $last.step NULL $fixed [1] FALSE $iterations function 29 $type [1] "BFGS maximization" $constraints NULL $gradientObs [,1] [1,] -0.37304 [2,] 0.25392 [3,] 0.88088 [4,] -0.37304 [5,] -0.68652 [6,] 0.25392 [7,] -0.05956 [8,] 0.25392 [9,] 0.88088 [10,] -0.68652 [11,] -0.37304 [12,] -0.05956 [13,] -0.37304 [14,] -0.05956 [15,] -0.37304 [16,] -0.37304 [17,] -0.37304 [18,] 0.56740 [19,] -0.05956 [20,] 0.56740 [21,] 0.56740 [22,] 0.25392 [23,] -0.37304 [24,] -0.37304 [25,] -0.68652 [26,] -0.05956 [27,] -0.05956 [28,] 0.88088 [29,] -0.68652 [30,] 0.88088 [31,] -0.05956 [32,] -0.68652 [33,] -0.37304 [34,] -1.00000 [35,] -1.00000 [36,] -0.05956 [37,] -0.05956 [38,] -0.05956 [39,] -0.37304 [40,] -0.37304 [41,] 0.56740 [42,] -0.37304 [43,] 0.56740 [44,] -0.05956 [45,] 0.88088 [46,] -0.05956 [47,] 0.25392 [48,] -0.68652 [49,] 0.25392 [50,] -0.05956 [51,] -0.37304 [52,] -0.05956 [53,] 0.88088 [54,] 1.19436 [55,] 0.88088 [56,] -0.37304 [57,] -0.37304 [58,] -0.37304 [59,] -0.68652 [60,] -0.68652 [61,] -0.05956 [62,] -0.68652 [63,] 0.56740 [64,] 1.50784 [65,] 1.19436 [66,] 0.56740 [67,] 0.56740 [68,] -0.68652 [69,] 0.88088 [70,] 0.56740 [71,] 0.56740 [72,] 0.25392 [73,] -0.68652 [74,] 0.56740 [75,] -1.00000 [76,] 0.88088 [77,] -1.00000 [78,] 0.25392 [79,] -0.05956 [80,] -0.37304 [81,] 0.88088 [82,] 0.56740 [83,] -0.37304 [84,] -0.68652 [85,] -0.05956 [86,] -0.68652 [87,] 1.19436 [88,] 0.25392 [89,] -0.37304 [90,] -0.05956 [91,] 0.25392 [92,] -0.37304 [93,] -0.68652 [94,] -0.37304 [95,] -0.37304 [96,] 0.56740 [97,] -0.37304 [98,] -0.05956 [99,] -0.05956 [100,] -0.05956 $control 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 = 200 printLevel = 0 > class( a ) [1] "maxim" > a <- roundGradients( a ) > summary( a ) -------------------------------------------- BFGS maximization Number of iterations: 29 Return code: 0 successful convergence Function value: -199.2 Estimates: estimate gradient [1,] 3.19 0 -------------------------------------------- > # you would probably prefer mean(n) instead of that ;-) > # Note also that maxLik is better suited for Maximum Likelihood > > > ### logLik.maxLik > set.seed( 4 ) > ## 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) > printRounded( a ) $maximum [1] -25.05 $estimate [1] 2.116 $gradient [1] 0 $hessian [,1] [1,] -22.34 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] 0.387 [2,] -1.679 [3,] 0.039 [4,] 0.071 [5,] 0.159 [6,] 0.105 [7,] 0.248 [8,] 0.447 [9,] 0.218 [10,] 0.054 [11,] -0.868 [12,] 0.329 [13,] 0.270 [14,] 0.258 [15,] 0.303 [16,] -0.052 [17,] 0.443 [18,] 0.406 [19,] -0.447 [20,] -0.033 [21,] 0.351 [22,] -0.151 [23,] -2.297 [24,] 0.389 [25,] -0.444 [26,] 0.443 [27,] 0.277 [28,] -0.151 [29,] 0.227 [30,] 0.192 [31,] -0.216 [32,] -0.427 [33,] -0.416 [34,] 0.278 [35,] -0.637 [36,] 0.395 [37,] 0.344 [38,] -0.620 [39,] 0.458 [40,] 0.167 [41,] 0.354 [42,] -0.065 [43,] 0.148 [44,] 0.283 [45,] -0.015 [46,] 0.080 [47,] 0.274 [48,] 0.452 [49,] -1.145 [50,] 0.405 [51,] -0.228 [52,] 0.433 [53,] 0.081 [54,] -0.081 [55,] -0.740 [56,] 0.207 [57,] 0.114 [58,] 0.119 [59,] 0.343 [60,] 0.093 [61,] 0.440 [62,] -0.073 [63,] -0.501 [64,] 0.075 [65,] -0.172 [66,] 0.045 [67,] -0.026 [68,] 0.182 [69,] 0.448 [70,] -0.160 [71,] 0.440 [72,] 0.248 [73,] 0.403 [74,] -0.191 [75,] -0.473 [76,] -0.065 [77,] -0.455 [78,] 0.160 [79,] 0.377 [80,] 0.122 [81,] 0.302 [82,] -0.001 [83,] 0.414 [84,] 0.401 [85,] 0.349 [86,] -0.997 [87,] 0.379 [88,] 0.385 [89,] -0.317 [90,] 0.193 [91,] 0.329 [92,] -0.042 [93,] 0.061 [94,] -0.645 [95,] -0.633 [96,] -0.356 [97,] -0.324 [98,] 0.221 [99,] -0.833 [100,] 0.361 $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -25.05 (1 free parameter(s)) Estimate(s): 2.116 > ## print log likelihood value > logLik( a ) [1] -25.05 > ## compare with log likelihood value of summary object > all.equal( logLik( a ), logLik( summary( a ) ) ) [1] TRUE > > > ### maxBHHH > set.seed( 6 ) > ## ML estimation of exponential duration model: > t <- rexp(100, 2) > ## Estimate with numeric gradient and hessian > a <- maxBHHH(loglik, start=1, print.level=2) ----- Initial parameters: ----- fcn value: -45.5 parameter initial gradient free [1,] 1 54.5 1 Condition number of the (active) hessian: 1 -----Iteration 1 ----- -----Iteration 2 ----- -----Iteration 3 ----- -----Iteration 4 ----- -----Iteration 5 ----- -------------- successive function values within tolerance limit 5 iterations estimate: 2.198 Function value: -21.25 > print( a ) $maximum [1] -21.25 $estimate [1] 2.198 $gradient [1] 0.0003862 $hessian [,1] [1,] -18.42 attr(,"type") [1] "BHHH" $code [1] 2 $message [1] "successive function values within tolerance limit" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "BHHH maximisation" $gradientObs [,1] [1,] 0.34872 [2,] 0.36337 [3,] 0.14751 [4,] 0.27836 [5,] -0.60055 [6,] 0.31142 [7,] 0.42198 [8,] 0.18506 [9,] 0.09663 [10,] 0.43709 [11,] 0.27714 [12,] -0.32707 [13,] 0.25446 [14,] 0.41365 [15,] -0.34761 [16,] -0.10404 [17,] 0.35989 [18,] 0.43322 [19,] -0.24284 [20,] 0.40754 [21,] 0.43446 [22,] 0.21307 [23,] -0.72491 [24,] 0.16847 [25,] -0.73113 [26,] 0.41303 [27,] 0.13127 [28,] 0.30143 [29,] 0.03316 [30,] -0.32514 [31,] 0.26619 [32,] 0.33719 [33,] -0.63494 [34,] 0.42640 [35,] 0.41133 [36,] 0.21917 [37,] -0.23050 [38,] 0.42825 [39,] 0.43629 [40,] -0.49029 [41,] -0.86638 [42,] -0.05708 [43,] 0.17052 [44,] -0.06488 [45,] -0.04141 [46,] 0.21592 [47,] -0.27989 [48,] -0.04166 [49,] 0.44931 [50,] 0.28868 [51,] 0.38041 [52,] -0.29423 [53,] -0.12650 [54,] -0.52837 [55,] 0.05775 [56,] 0.39261 [57,] 0.41131 [58,] 0.21082 [59,] 0.43311 [60,] -0.11064 [61,] -1.08885 [62,] 0.28892 [63,] 0.41071 [64,] -0.57920 [65,] 0.37021 [66,] -0.10011 [67,] -0.31689 [68,] 0.31029 [69,] -1.05871 [70,] 0.17639 [71,] 0.37380 [72,] 0.02796 [73,] -0.46422 [74,] -0.65734 [75,] -0.11962 [76,] -0.08873 [77,] -0.35161 [78,] 0.09842 [79,] -0.14749 [80,] 0.36913 [81,] -0.23146 [82,] 0.18957 [83,] 0.18226 [84,] 0.12719 [85,] 0.44356 [86,] 0.28876 [87,] 0.38632 [88,] -0.96035 [89,] 0.45399 [90,] 0.27527 [91,] -0.13580 [92,] -0.19583 [93,] -0.24698 [94,] -0.81480 [95,] 0.17887 [96,] -1.18544 [97,] 0.41696 [98,] 0.38062 [99,] -1.16809 [100,] -0.63346 $control 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 = 150 printLevel = 2 attr(,"class") [1] "maxim" "list" > a <- roundGradients( a ) > summary(a) -------------------------------------------- BHHH maximisation Number of iterations: 5 Return code: 2 successive function values within tolerance limit Function value: -21.25 Estimates: estimate gradient [1,] 2.198 0 -------------------------------------------- > ## Estimate with analytic gradient > a <- maxBHHH(loglik, gradlik, start=1) > print( a ) $maximum [1] -21.25 $estimate [1] 2.198 $gradient [1] 0.0003862 $hessian [,1] [1,] -18.42 attr(,"type") [1] "BHHH" $code [1] 2 $message [1] "successive function values within tolerance limit" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "BHHH maximisation" $gradientObs [,1] [1,] 0.34872 [2,] 0.36337 [3,] 0.14751 [4,] 0.27836 [5,] -0.60055 [6,] 0.31142 [7,] 0.42198 [8,] 0.18506 [9,] 0.09663 [10,] 0.43709 [11,] 0.27714 [12,] -0.32707 [13,] 0.25446 [14,] 0.41365 [15,] -0.34761 [16,] -0.10404 [17,] 0.35989 [18,] 0.43322 [19,] -0.24284 [20,] 0.40754 [21,] 0.43446 [22,] 0.21307 [23,] -0.72491 [24,] 0.16847 [25,] -0.73113 [26,] 0.41303 [27,] 0.13127 [28,] 0.30143 [29,] 0.03316 [30,] -0.32514 [31,] 0.26619 [32,] 0.33719 [33,] -0.63494 [34,] 0.42640 [35,] 0.41133 [36,] 0.21917 [37,] -0.23050 [38,] 0.42825 [39,] 0.43629 [40,] -0.49029 [41,] -0.86638 [42,] -0.05708 [43,] 0.17052 [44,] -0.06488 [45,] -0.04141 [46,] 0.21592 [47,] -0.27989 [48,] -0.04166 [49,] 0.44931 [50,] 0.28868 [51,] 0.38041 [52,] -0.29423 [53,] -0.12650 [54,] -0.52837 [55,] 0.05775 [56,] 0.39261 [57,] 0.41131 [58,] 0.21082 [59,] 0.43311 [60,] -0.11064 [61,] -1.08885 [62,] 0.28892 [63,] 0.41071 [64,] -0.57920 [65,] 0.37021 [66,] -0.10011 [67,] -0.31689 [68,] 0.31029 [69,] -1.05871 [70,] 0.17639 [71,] 0.37380 [72,] 0.02796 [73,] -0.46422 [74,] -0.65734 [75,] -0.11962 [76,] -0.08873 [77,] -0.35161 [78,] 0.09842 [79,] -0.14749 [80,] 0.36913 [81,] -0.23146 [82,] 0.18957 [83,] 0.18226 [84,] 0.12719 [85,] 0.44356 [86,] 0.28876 [87,] 0.38632 [88,] -0.96035 [89,] 0.45399 [90,] 0.27527 [91,] -0.13580 [92,] -0.19583 [93,] -0.24698 [94,] -0.81480 [95,] 0.17887 [96,] -1.18544 [97,] 0.41696 [98,] 0.38062 [99,] -1.16809 [100,] -0.63346 $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > a <- roundGradients( a ) > summary(a) -------------------------------------------- BHHH maximisation Number of iterations: 5 Return code: 2 successive function values within tolerance limit Function value: -21.25 Estimates: estimate gradient [1,] 2.198 0 -------------------------------------------- > > > ### maxLik > set.seed( 7 ) > ## ML estimation of exponential duration model: > t <- rexp(100, 2) > ## Estimate with numeric gradient and hessian > a <- maxLik(loglik, start=1, print.level=2) ----- Initial parameters: ----- fcn value: -47.72 parameter initial gradient free [1,] 1 52.28 1 Condition number of the (active) hessian: 1 -----Iteration 1 ----- -----Iteration 2 ----- -----Iteration 3 ----- -----Iteration 4 ----- -----Iteration 5 ----- -------------- gradient close to zero 5 iterations estimate: 2.095 Function value: -26.03 > printRounded( a ) $maximum [1] -26.03 $estimate [1] 2.095 $gradient [1] 0 $hessian [,1] [1,] -22.76 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] 0.453 [2,] -0.334 [3,] -0.379 [4,] 0.071 [5,] 0.204 [6,] -0.833 [7,] 0.101 [8,] -1.659 [9,] 0.375 [10,] 0.454 [11,] 0.005 [12,] 0.103 [13,] -0.459 [14,] -0.456 [15,] -0.128 [16,] 0.305 [17,] 0.139 [18,] -0.002 [19,] 0.218 [20,] 0.020 [21,] -0.723 [22,] 0.161 [23,] 0.279 [24,] 0.257 [25,] 0.203 [26,] 0.349 [27,] 0.254 [28,] -0.143 [29,] -0.367 [30,] -0.465 [31,] -0.152 [32,] 0.083 [33,] -0.484 [34,] 0.473 [35,] 0.213 [36,] 0.284 [37,] 0.433 [38,] 0.318 [39,] 0.014 [40,] 0.031 [41,] 0.137 [42,] 0.356 [43,] -0.254 [44,] 0.410 [45,] -0.021 [46,] 0.173 [47,] -0.243 [48,] -0.821 [49,] 0.215 [50,] -0.065 [51,] -0.203 [52,] -0.057 [53,] -1.640 [54,] 0.414 [55,] 0.405 [56,] 0.437 [57,] -0.079 [58,] 0.153 [59,] -0.460 [60,] -0.162 [61,] -0.003 [62,] -0.057 [63,] 0.462 [64,] -0.531 [65,] 0.292 [66,] -0.162 [67,] -1.126 [68,] 0.348 [69,] 0.411 [70,] 0.188 [71,] -0.452 [72,] 0.145 [73,] 0.447 [74,] 0.054 [75,] 0.271 [76,] -0.012 [77,] 0.218 [78,] -0.357 [79,] 0.352 [80,] -0.832 [81,] 0.198 [82,] 0.472 [83,] 0.249 [84,] 0.168 [85,] 0.219 [86,] 0.172 [87,] 0.310 [88,] 0.464 [89,] -0.428 [90,] 0.414 [91,] 0.093 [92,] 0.258 [93,] -0.488 [94,] 0.460 [95,] -0.802 [96,] 0.412 [97,] 0.054 [98,] 0.179 [99,] -0.136 [100,] 0.166 $control 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 = 150 printLevel = 2 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -26.03 (1 free parameter(s)) Estimate(s): 2.095 > summary(a) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -26.03 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.10 0.21 10 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > ## Estimate with analytic gradient and hessian > a <- maxLik(loglik, gradlik, hesslik, start=1) > printRounded( a ) $maximum [1] -26.03 $estimate [1] 2.095 $gradient [1] 0 $hessian [,1] [1,] -22.78 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] 0.453 [2,] -0.334 [3,] -0.379 [4,] 0.071 [5,] 0.204 [6,] -0.833 [7,] 0.101 [8,] -1.659 [9,] 0.375 [10,] 0.454 [11,] 0.005 [12,] 0.103 [13,] -0.459 [14,] -0.456 [15,] -0.128 [16,] 0.305 [17,] 0.139 [18,] -0.002 [19,] 0.218 [20,] 0.020 [21,] -0.723 [22,] 0.161 [23,] 0.279 [24,] 0.257 [25,] 0.203 [26,] 0.349 [27,] 0.254 [28,] -0.143 [29,] -0.367 [30,] -0.465 [31,] -0.152 [32,] 0.083 [33,] -0.484 [34,] 0.473 [35,] 0.213 [36,] 0.284 [37,] 0.433 [38,] 0.318 [39,] 0.014 [40,] 0.031 [41,] 0.137 [42,] 0.356 [43,] -0.254 [44,] 0.410 [45,] -0.021 [46,] 0.173 [47,] -0.243 [48,] -0.821 [49,] 0.215 [50,] -0.065 [51,] -0.203 [52,] -0.057 [53,] -1.640 [54,] 0.414 [55,] 0.405 [56,] 0.437 [57,] -0.079 [58,] 0.153 [59,] -0.460 [60,] -0.162 [61,] -0.003 [62,] -0.057 [63,] 0.462 [64,] -0.531 [65,] 0.292 [66,] -0.162 [67,] -1.126 [68,] 0.348 [69,] 0.411 [70,] 0.188 [71,] -0.452 [72,] 0.145 [73,] 0.447 [74,] 0.054 [75,] 0.271 [76,] -0.012 [77,] 0.218 [78,] -0.357 [79,] 0.352 [80,] -0.832 [81,] 0.198 [82,] 0.472 [83,] 0.249 [84,] 0.168 [85,] 0.219 [86,] 0.172 [87,] 0.310 [88,] 0.464 [89,] -0.428 [90,] 0.414 [91,] 0.093 [92,] 0.258 [93,] -0.488 [94,] 0.460 [95,] -0.802 [96,] 0.412 [97,] 0.054 [98,] 0.179 [99,] -0.136 [100,] 0.166 $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -26.03 (1 free parameter(s)) Estimate(s): 2.095 > summary(a) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -26.03 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.10 0.21 10 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > > > ### maxNR > set.seed( 8 ) > ## ML estimation of exponential duration model: > t <- rexp(100, 2) > loglikSum <- function(theta) sum(log(theta) - theta*t) > ## Note the log-likelihood and gradient are summed over observations > gradlikSum <- function(theta) sum(1/theta - t) > ## Estimate with numeric gradient and Hessian > a <- maxNR(loglikSum, start=1, print.level=2) ----- Initial parameters: ----- fcn value: -46.49 parameter initial gradient free [1,] 1 53.51 1 Condition number of the (active) hessian: 1 -----Iteration 1 ----- -----Iteration 2 ----- -----Iteration 3 ----- -----Iteration 4 ----- -----Iteration 5 ----- -------------- gradient close to zero 5 iterations estimate: 2.151 Function value: -23.41 > a <- roundGradients( a ) > print( a ) $maximum [1] -23.41 $estimate [1] 2.151 $gradient [1] 0 $hessian [,1] [1,] -21.62 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 2 attr(,"class") [1] "maxim" "list" > summary(a) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 5 Return code: 1 gradient close to zero Function value: -23.41 Estimates: estimate gradient [1,] 2.151 0 -------------------------------------------- > ## You would probably prefer 1/mean(t) instead ;-) > ## Estimate with analytic gradient and Hessian > a <- maxNR(loglikSum, gradlikSum, hesslik, start=1) > a <- roundGradients( a ) > print( a ) $maximum [1] -23.41 $estimate [1] 2.151 $gradient [1] 0 $hessian [,1] [1,] -21.61 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > summary(a) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 5 Return code: 1 gradient close to zero Function value: -23.41 Estimates: estimate gradient [1,] 2.151 0 -------------------------------------------- > > > ### maximType > ## maximise two-dimensional exponential hat. Maximum is at c(2,1): > f <- function(a) exp(-(a[1] - 2)^2 - (a[2] - 1)^2) > m <- maxNR(f, start=c(0,0)) > m <- roundGradients( m ) > print( m ) $maximum [1] 1 $estimate [1] 2 1 $gradient [1] 0 0 $hessian [,1] [,2] [1,] -2 0 [2,] 0 -2 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE FALSE $iterations [1] 7 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > summary(m) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 7 Return code: 1 gradient close to zero Function value: 1 Estimates: estimate gradient [1,] 2 0 [2,] 1 0 -------------------------------------------- > maximType(m) [1] "Newton-Raphson maximisation" > ## Now use BFGS maximisation. > m <- maxBFGS(f, start=c(0,0)) > m <- roundGradients( m ) > print( m ) $maximum [1] 1 $estimate [1] 2 1 $gradient [1] 0 0 $hessian [,1] [,2] [1,] -2 0 [2,] 0 -2 $code [1] 0 $message [1] "successful convergence " $last.step NULL $fixed [1] FALSE FALSE $iterations function 26 $type [1] "BFGS maximization" $constraints NULL $control 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 = 200 printLevel = 0 attr(,"class") [1] "maxim" > summary(m) -------------------------------------------- BFGS maximization Number of iterations: 26 Return code: 0 successful convergence Function value: 1 Estimates: estimate gradient [1,] 2 0 [2,] 1 0 -------------------------------------------- > maximType(m) [1] "BFGS maximization" > > ### Test maxNR with 0 iterations. Should perform no iterations > ### Request by Yves Croissant > f <- function(a) exp(-(a[1] - 2)^2 - (a[2] - 1)^2) > m0 <- maxNR(f, start=c(1.1, 2.1), iterlim=0) > m0 <- roundGradients( m0 ) > summary(m0) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 0 Return code: 4 Iteration limit exceeded. Function value: 0.1327 Estimates: estimate gradient [1,] 1.1 0.239 [2,] 2.1 -0.292 -------------------------------------------- > > ### nObs > set.seed( 10 ) > # Construct a simple OLS regression: > x1 <- runif(100) > x2 <- runif(100) > y <- 3 + 4*x1 + 5*x2 + rnorm(100) > m <- lm(y~x1+x2) # estimate it > nObs(m) [1] 100 > > > ### nParam > set.seed( 11 ) > # Construct a simple OLS regression: > x1 <- runif(100) > x2 <- runif(100) > y <- 3 + 4*x1 + 5*x2 + rnorm(100) > m <- lm(y~x1+x2) # estimate it > summary(m) Call: lm(formula = y ~ x1 + x2) Residuals: Min 1Q Median 3Q Max -2.3436 -0.5338 -0.0291 0.5501 2.6934 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 3.242 0.287 11.3 <2e-16 *** x1 3.974 0.395 10.1 <2e-16 *** x2 4.783 0.367 13.0 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.99 on 97 degrees of freedom Multiple R-squared: 0.702, Adjusted R-squared: 0.696 F-statistic: 114 on 2 and 97 DF, p-value: <2e-16 > nParam(m) # you get 3 [1] 3 > > > ### numericGradient > # A simple example with Gaussian bell > f0 <- function(t0) exp(-t0[1]^2 - t0[2]^2) > numericGradient(f0, c(1,2)) [,1] [,2] [1,] -0.01348 -0.02695 > numericHessian(f0, t0=c(1,2)) [,1] [,2] [1,] 0.01349 0.05390 [2,] 0.05390 0.09433 > # An example with the analytic gradient > gradf0 <- function(t0) -2*t0*f0(t0) > numericHessian(f0, gradf0, t0=c(1,2)) [,1] [,2] [1,] 0.01348 0.05390 [2,] 0.05390 0.09433 > # The results should be similar as in the previous case > # The central numeric derivatives have usually quite a high precision > compareDerivatives(f0, gradf0, t0=1:2) -------- compare derivatives -------- Note: analytic gradient is vector. Transforming into a matrix form Function value: [1] 0.006738 Dim of analytic gradient: 1 2 numeric : 1 2 t0 [1] 1 2 analytic gradient [,1] [,2] [1,] -0.01348 -0.02695 numeric gradient [,1] [,2] [1,] -0.01348 -0.02695 (anal-num)/(0.5*(abs(anal)+abs(num))) [,1] [,2] [1,] -2.764e-10 -5.108e-11 Max relative difference: 2.764e-10 -------- END of compare derivatives -------- > # The differenc is around 1e-10 > > > ### returnCode > ## maximise the exponential bell > f1 <- function(x) exp(-x^2) > a <- maxNR(f1, start=2) > a <- roundGradients( a ) > print( a ) $maximum [1] 1 $estimate [1] 3.632e-10 $gradient [1] 0 $hessian [,1] [1,] -2 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 4 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > returnCode(a) # should be success (1 or 2) [1] 1 > ## Now try to maximise log() function > a <- maxNR(log, start=2) > returnCode(a) # should give a failure (4) [1] 4 > > > ### returnMessage > ## maximise the exponential bell > f1 <- function(x) exp(-x^2) > a <- maxNR(f1, start=2) > a <- roundGradients( a ) > print( a ) $maximum [1] 1 $estimate [1] 3.632e-10 $gradient [1] 0 $hessian [,1] [1,] -2 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 4 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > returnMessage(a) # should be success (1 or 2) [1] "gradient close to zero" > ## Now try to maximise log() function > f2 <- function(x) log(x) > a <- maxNR(log, start=2) > returnMessage(a) # should give 'Iteration limit exceeded.' [1] "Iteration limit exceeded." > > > ### summary.maxLik > set.seed( 15 ) > ## 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 numeric gradient and hessian > a <- maxLik(loglik, start=1, print.level=2) ----- Initial parameters: ----- fcn value: -41.56 parameter initial gradient free [1,] 1 58.44 1 Condition number of the (active) hessian: 1 -----Iteration 1 ----- -----Iteration 2 ----- -----Iteration 3 ----- -----Iteration 4 ----- -----Iteration 5 ----- -------------- gradient close to zero 5 iterations estimate: 2.406 Function value: -12.2 > printRounded( a ) $maximum [1] -12.2 $estimate [1] 2.406 $gradient [1] 0 $hessian [,1] [1,] -17.27 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] 0.313 [2,] -0.558 [3,] 0.288 [4,] 0.328 [5,] 0.084 [6,] -0.961 [7,] 0.269 [8,] 0.407 [9,] 0.209 [10,] 0.261 [11,] 0.367 [12,] 0.112 [13,] 0.122 [14,] -0.146 [15,] -1.167 [16,] -0.676 [17,] -0.020 [18,] 0.028 [19,] -0.729 [20,] 0.257 [21,] 0.051 [22,] -0.119 [23,] -0.045 [24,] 0.072 [25,] -1.860 [26,] 0.249 [27,] 0.201 [28,] 0.147 [29,] 0.330 [30,] 0.288 [31,] 0.139 [32,] 0.098 [33,] 0.022 [34,] -0.075 [35,] 0.242 [36,] 0.141 [37,] -0.093 [38,] 0.083 [39,] 0.180 [40,] -0.241 [41,] 0.235 [42,] 0.325 [43,] -0.310 [44,] 0.274 [45,] 0.151 [46,] 0.359 [47,] -0.166 [48,] 0.117 [49,] 0.411 [50,] -0.856 [51,] 0.369 [52,] 0.012 [53,] 0.091 [54,] -0.419 [55,] 0.163 [56,] 0.381 [57,] -0.241 [58,] 0.393 [59,] 0.187 [60,] -0.070 [61,] -0.526 [62,] 0.367 [63,] 0.217 [64,] 0.219 [65,] 0.258 [66,] 0.398 [67,] 0.298 [68,] -0.031 [69,] -0.100 [70,] -0.657 [71,] 0.052 [72,] -0.671 [73,] 0.324 [74,] -0.752 [75,] 0.209 [76,] -1.050 [77,] 0.394 [78,] -0.131 [79,] -1.349 [80,] -0.050 [81,] 0.237 [82,] -0.017 [83,] 0.154 [84,] 0.275 [85,] 0.158 [86,] -0.430 [87,] 0.215 [88,] 0.414 [89,] 0.218 [90,] 0.221 [91,] -0.072 [92,] 0.270 [93,] -0.070 [94,] 0.308 [95,] -0.178 [96,] 0.153 [97,] 0.185 [98,] 0.075 [99,] 0.365 [100,] 0.094 $control 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 = 150 printLevel = 2 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -12.2 (1 free parameter(s)) Estimate(s): 2.406 > summary(a) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -12.2 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.406 0.241 10 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > ## Estimate with analytic gradient and hessian > a <- maxLik(loglik, gradlik, hesslik, start=1) > printRounded( a ) $maximum [1] -12.2 $estimate [1] 2.406 $gradient [1] 0 $hessian [,1] [1,] -17.27 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 6 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] 0.313 [2,] -0.558 [3,] 0.288 [4,] 0.328 [5,] 0.084 [6,] -0.961 [7,] 0.269 [8,] 0.407 [9,] 0.209 [10,] 0.261 [11,] 0.367 [12,] 0.112 [13,] 0.122 [14,] -0.146 [15,] -1.167 [16,] -0.676 [17,] -0.020 [18,] 0.028 [19,] -0.729 [20,] 0.257 [21,] 0.051 [22,] -0.119 [23,] -0.045 [24,] 0.072 [25,] -1.860 [26,] 0.249 [27,] 0.201 [28,] 0.147 [29,] 0.330 [30,] 0.288 [31,] 0.139 [32,] 0.098 [33,] 0.022 [34,] -0.075 [35,] 0.242 [36,] 0.141 [37,] -0.093 [38,] 0.083 [39,] 0.180 [40,] -0.241 [41,] 0.235 [42,] 0.325 [43,] -0.310 [44,] 0.274 [45,] 0.151 [46,] 0.359 [47,] -0.166 [48,] 0.117 [49,] 0.411 [50,] -0.856 [51,] 0.369 [52,] 0.012 [53,] 0.091 [54,] -0.419 [55,] 0.163 [56,] 0.381 [57,] -0.241 [58,] 0.393 [59,] 0.187 [60,] -0.070 [61,] -0.526 [62,] 0.367 [63,] 0.217 [64,] 0.219 [65,] 0.258 [66,] 0.398 [67,] 0.298 [68,] -0.031 [69,] -0.100 [70,] -0.657 [71,] 0.052 [72,] -0.671 [73,] 0.324 [74,] -0.752 [75,] 0.209 [76,] -1.050 [77,] 0.394 [78,] -0.131 [79,] -1.349 [80,] -0.050 [81,] 0.237 [82,] -0.017 [83,] 0.154 [84,] 0.275 [85,] 0.158 [86,] -0.430 [87,] 0.215 [88,] 0.414 [89,] 0.218 [90,] 0.221 [91,] -0.072 [92,] 0.270 [93,] -0.070 [94,] 0.308 [95,] -0.178 [96,] 0.153 [97,] 0.185 [98,] 0.075 [99,] 0.365 [100,] 0.094 $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 1: gradient close to zero Log-Likelihood: -12.2 (1 free parameter(s)) Estimate(s): 2.406 > summary(a) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 6 iterations Return code 1: gradient close to zero Log-Likelihood: -12.2 1 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 2.406 0.241 10 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > > > ### summary.maxim and for "gradient"/"hessian" attributes > ### Test for infinity > ## maximize 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 + } > ## Use c(0,0) as initial value. > result1 <- maxNR( f, start = c(0,0) ) > print( result1 ) $maximum [1] Inf $estimate [1] -7.035e+155 -1.055e+156 $gradient [1] -1.407e+156 -2.110e+156 $hessian [,1] [,2] [1,] 2 0 [2,] 0 2 $code [1] 5 $message [1] "Infinite value" $last.step NULL $fixed [1] FALSE FALSE $iterations [1] 25 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > summary( result1 ) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 25 Return code: 5 Infinite value Function value: Inf Estimates: estimate gradient [1,] -7.035e+155 -1.407e+156 [2,] -1.055e+156 -2.110e+156 -------------------------------------------- > ## Now use c(1000000, -777777) as initial value and ask for hessian > result2 <- maxNR( f, start = c( 1000000, -777777)) > print( result2 ) $maximum [1] Inf $estimate [1] 2.110e+155 -1.641e+155 $gradient [1] 4.221e+155 -3.283e+155 $hessian [,1] [,2] [1,] 2 0 [2,] 0 2 $code [1] 5 $message [1] "Infinite value" $last.step NULL $fixed [1] FALSE FALSE $iterations [1] 24 $type [1] "Newton-Raphson maximisation" $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxim" "list" > summary( result2 ) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 24 Return code: 5 Infinite value Function value: Inf Estimates: estimate gradient [1,] 2.110e+155 4.221e+155 [2,] -1.641e+155 -3.283e+155 -------------------------------------------- > > > ### Test for "gradient"/"hessian" attributes. A case which converges. > hub <- function(x) { + v <- exp(-sum(x*x)) + val <- v + attr(val, "gradient") <- -2*x*v + attr(val, "hessian") <- 4*(x %*% t(x))*v - diag(2*c(v, v)) + val + } > a <- maxNR(hub, start=c(2,1)) > a <- roundGradients( a ) > summary( a ) -------------------------------------------- Newton-Raphson maximisation Number of iterations: 7 Return code: 1 gradient close to zero Function value: 1 Estimates: estimate gradient [1,] -7.448e-18 0 [2,] -3.724e-18 0 -------------------------------------------- > ## Now test "gradient" attribute for BHHH/3-parameter probit > N <- 1000 > loglikProbit <- function( beta) { + xb <- x %*% beta + loglik <- ifelse(y == 0, + pnorm( xb, log=TRUE, lower.tail=FALSE), + pnorm( xb, log.p=TRUE)) + grad <- ifelse(y == 0, + -dnorm(xb)/pnorm(xb, lower.tail=FALSE), + dnorm(xb)/pnorm(xb)) + grad <- grad*x + attr(loglik, "gradient") <- grad + loglik + } > x <- runif(N) > x <- cbind(x, x - runif(N), x - runif(N)) > y <- x[,1] + 2*x[,2] - x[,3] + rnorm(N) > 0 > summary(maxLik(loglikProbit, start=c(0,0,0), method="bhhh")) -------------------------------------------- Maximum Likelihood estimation BHHH maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -508.4 3 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.8578 0.0904 9.49 < 2e-16 *** [2,] 1.9389 0.1514 12.81 < 2e-16 *** [3,] -0.8253 0.1339 -6.16 7.2e-10 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 -------------------------------------------- > > > > ### vcov.maxLik > set.seed( 17 ) > ## ML estimation of exponential duration model: > t <- rexp(100, 2) > ## Estimate with numeric gradient and hessian > a <- maxLik(loglik, start=1, print.level=2) ----- Initial parameters: ----- fcn value: -53.67 parameter initial gradient free [1,] 1 46.33 1 Condition number of the (active) hessian: 1 -----Iteration 1 ----- -----Iteration 2 ----- -----Iteration 3 ----- -----Iteration 4 ----- -----Iteration 5 ----- -------------- gradient close to zero 5 iterations estimate: 1.863 Function value: -37.76 > printRounded( a ) $maximum [1] -37.76 $estimate [1] 1.863 $gradient [1] 0 $hessian [,1] [1,] -28.79 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] -0.277 [2,] 0.395 [3,] 0.498 [4,] -0.484 [5,] -0.405 [6,] 0.257 [7,] -0.432 [8,] 0.189 [9,] 0.207 [10,] 0.328 [11,] 0.166 [12,] 0.394 [13,] 0.510 [14,] 0.326 [15,] 0.234 [16,] 0.505 [17,] 0.461 [18,] 0.461 [19,] -1.064 [20,] 0.238 [21,] -0.046 [22,] 0.473 [23,] -0.400 [24,] 0.235 [25,] 0.285 [26,] 0.403 [27,] -0.238 [28,] 0.441 [29,] 0.482 [30,] 0.495 [31,] -0.365 [32,] 0.388 [33,] -0.407 [34,] -0.181 [35,] 0.419 [36,] -0.330 [37,] -0.240 [38,] -0.415 [39,] 0.461 [40,] -3.893 [41,] 0.033 [42,] -0.629 [43,] 0.432 [44,] 0.036 [45,] 0.246 [46,] -0.227 [47,] 0.531 [48,] 0.516 [49,] -0.677 [50,] 0.153 [51,] 0.222 [52,] 0.436 [53,] -1.563 [54,] -0.050 [55,] 0.312 [56,] -0.146 [57,] -0.357 [58,] 0.481 [59,] 0.399 [60,] 0.423 [61,] 0.330 [62,] 0.353 [63,] -0.302 [64,] 0.471 [65,] 0.291 [66,] 0.120 [67,] 0.507 [68,] -0.250 [69,] -0.050 [70,] 0.280 [71,] 0.526 [72,] -0.374 [73,] 0.024 [74,] -0.413 [75,] -0.359 [76,] 0.477 [77,] 0.242 [78,] -0.041 [79,] -1.348 [80,] -0.257 [81,] 0.324 [82,] 0.345 [83,] -0.934 [84,] 0.332 [85,] -0.850 [86,] 0.316 [87,] 0.475 [88,] 0.373 [89,] -0.025 [90,] 0.377 [91,] -2.108 [92,] -0.450 [93,] 0.168 [94,] 0.351 [95,] 0.525 [96,] -0.066 [97,] 0.388 [98,] 0.253 [99,] -0.797 [100,] 0.133 $control 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 = 150 printLevel = 2 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -37.76 (1 free parameter(s)) Estimate(s): 1.863 > round( vcov( a ), 3 ) [,1] [1,] 0.035 > ## Estimate with analytic gradient and hessian > a <- maxLik(loglik, gradlik, hesslik, start=1) > printRounded( a ) $maximum [1] -37.76 $estimate [1] 1.863 $gradient [1] 0 $hessian [,1] [1,] -28.8 $code [1] 1 $message [1] "gradient close to zero" $last.step NULL $fixed [1] FALSE $iterations [1] 5 $type [1] "Newton-Raphson maximisation" $gradientObs [,1] [1,] -0.277 [2,] 0.395 [3,] 0.498 [4,] -0.484 [5,] -0.405 [6,] 0.257 [7,] -0.432 [8,] 0.189 [9,] 0.207 [10,] 0.328 [11,] 0.166 [12,] 0.394 [13,] 0.510 [14,] 0.326 [15,] 0.234 [16,] 0.505 [17,] 0.461 [18,] 0.461 [19,] -1.064 [20,] 0.238 [21,] -0.046 [22,] 0.473 [23,] -0.400 [24,] 0.235 [25,] 0.285 [26,] 0.403 [27,] -0.238 [28,] 0.441 [29,] 0.482 [30,] 0.495 [31,] -0.365 [32,] 0.388 [33,] -0.407 [34,] -0.181 [35,] 0.419 [36,] -0.330 [37,] -0.240 [38,] -0.415 [39,] 0.461 [40,] -3.893 [41,] 0.033 [42,] -0.629 [43,] 0.432 [44,] 0.036 [45,] 0.246 [46,] -0.227 [47,] 0.531 [48,] 0.516 [49,] -0.677 [50,] 0.153 [51,] 0.222 [52,] 0.436 [53,] -1.563 [54,] -0.050 [55,] 0.312 [56,] -0.146 [57,] -0.357 [58,] 0.481 [59,] 0.399 [60,] 0.423 [61,] 0.330 [62,] 0.353 [63,] -0.302 [64,] 0.471 [65,] 0.291 [66,] 0.120 [67,] 0.507 [68,] -0.250 [69,] -0.050 [70,] 0.280 [71,] 0.526 [72,] -0.374 [73,] 0.024 [74,] -0.413 [75,] -0.359 [76,] 0.477 [77,] 0.242 [78,] -0.041 [79,] -1.348 [80,] -0.257 [81,] 0.324 [82,] 0.345 [83,] -0.934 [84,] 0.332 [85,] -0.850 [86,] 0.316 [87,] 0.475 [88,] 0.373 [89,] -0.025 [90,] 0.377 [91,] -2.108 [92,] -0.450 [93,] 0.168 [94,] 0.351 [95,] 0.525 [96,] -0.066 [97,] 0.388 [98,] 0.253 [99,] -0.797 [100,] 0.133 $control 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 = 150 printLevel = 0 attr(,"class") [1] "maxLik" "maxim" "list" > print( a ) Maximum Likelihood estimation Newton-Raphson maximisation, 5 iterations Return code 1: gradient close to zero Log-Likelihood: -37.76 (1 free parameter(s)) Estimate(s): 1.863 > round( vcov( a ), 3 ) [,1] [1,] 0.035 > print(stdEr(a)) [1] 0.1863 > # test single stdEr > > proc.time() user system elapsed 0.874 0.062 0.929 maxLik/tests/finalHessian.Rout.save0000644000176200001440000002650512603115317017064 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/numericGradient.Rout.save0000644000176200001440000000330312603115317017567 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.R0000644000176200001440000000366312603377060013643 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) { return( - t(D - (1:N) ) %*% W %*% ( D - (1:N) ) ) } N <- 3 # round gradients to increase reproducibility of the accuracy roundGradients <- function( object ) { object$gradient <- round( object$gradient, 3 ) return( object ) } # 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) res <- roundGradients( res ) summary(res) ## b) add noice to W <- diag(N) + matrix(runif(N*N), N, N) # diagonal weight matrix with some noise D <- rep(1/N, N) res <- maxBFGSR(quadForm, start=D, tol = 1e-10 ) res <- roundGradients( res ) summary(res) ## 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) hatNC <- roundGradients( hatNC ) summary( hatNC ) # should converge to c(0,0). ## 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) hat3CF <- roundGradients( hat3CF ) summary( hat3CF ) maxLik/tests/fitGammaDist.Rout.save0000644000176200001440000002322312603115317017023 0ustar liggesusers R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" 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. > ## the idea and most commands were provided by Marco J. Maier, Institute for > ## Statistics and Mathematics, Vienna University of Economics and Business > > 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(warn = -1, digits = 4 ) > set.seed(5) > some_data <- rgamma(1e4, shape = 5, scale = 2) > > # log-likelihood function(s) > logLL <- function(x, X) # per observation for maxLik + dgamma(x = X, shape = exp(x[1]), scale = exp(x[2]), log = TRUE) > logLL_sum <- function(x, X) # negative sum for nlm() + -sum(dgamma(x = X, shape = exp(x[1]), scale = exp(x[2]), log = TRUE)) > > sum(logLL(log(c(5,2)),some_data)) [1] -28528 > logLL_sum(log(c(5,2)),some_data) [1] 28528 > all.equal( sum(logLL(log(c(5,2)),some_data)), -logLL_sum(log(c(5,2)),some_data)) [1] TRUE > > # gradient of log-likelihood function > d_logLL <- function(x, X){ # analytic 1. derivatives + cbind(shape=exp(x[1])*(-x[2]-psigamma(exp(x[1]),0)+log(X)), + scale= X / exp(x[2]) - exp(x[1])) + } > > d_logLLNum <- function(x, X){ + numericGradient( logLL, x, X = X ) + } > > colSums(d_logLL(log(c(5,2)),some_data)) shape scale 92.95 135.27 > colSums(d_logLLNum(log(c(5,2)),some_data)) [1] 92.95 135.27 > > all.equal( d_logLL(log(c(5,2)),some_data), d_logLLNum(log(c(5,2)),some_data), + check.attributes=FALSE) [1] TRUE > > # Hessian of log-likelihood function > dd_logLL <- function(x, X){ # analytic 2. derivatives + grad <- d_logLL( x, X ) + hessian <- matrix(0, 2, 2) + hessian[1,1] <- sum( grad[,1] - exp(x[1])^2 * psigamma(exp(x[1]), 1) ) + hessian[2,2] <- - sum( X / exp(x[2]) ) + hessian[cbind(c(2,1), c(1,2))] <- -exp(x[1]) * length(X) + return(hessian) + } > > dd_logLLNum <- function(x, X){ + numericHessian( function(x,X) sum(logLL(x,X)), t0=x, X = X ) + } > dd_logLLNumGrad <- function(x, X){ + numericHessian( function(x,X) sum(logLL(x,X)), + grad = function(x,X) colSums(d_logLL(x,X)), x, X = X ) + } > > dd_logLL(log(c(5,2)),some_data) [,1] [,2] [1,] -55238 -50000 [2,] -50000 -50135 > dd_logLLNum(log(c(5,2)),some_data) [,1] [,2] [1,] -55235 -50000 [2,] -50000 -50135 > all.equal(dd_logLL(log(c(5,2)),some_data), dd_logLLNum(log(c(5,2)),some_data)) [1] "Mean relative difference: 1.655e-05" > dd_logLLNumGrad(log(c(5,2)),some_data) [,1] [,2] shape -55238 -50000 scale -50000 -50135 > all.equal(dd_logLL(log(c(5,2)),some_data), dd_logLLNumGrad(log(c(5,2)),some_data), + check.attributes=FALSE) [1] TRUE > > # estimation with nlm() > t_nlm <- system.time( r_nlm <- nlm(logLL_sum, c(0,0), X=some_data, hessian=TRUE) ) > > # estimation with nlm() and gradients > logLL_grad <- function(x, X) { + result <- logLL_sum( x, X ) + attr( result, "gradient" ) <- - colSums( d_logLL( x, X ) ) + return( result ) + } > t_nlmg <- system.time( r_nlmg <- nlm(logLL_grad, c(0,0), X=some_data, hessian=TRUE) ) > > # estimation with nlm() and gradients and Hessian > logLL_hess <- function(x, X) { + result <- logLL_sum( x, X ) + attr( result, "gradient" ) <- - colSums( d_logLL( x, X ) ) + attr( result, "hessian" ) <- - dd_logLL( x, X ) + return( result ) + } > t_nlmgh <- system.time( r_nlmgh <- nlm(logLL_hess, c(0,0), X=some_data, hessian=TRUE) ) > > # estimation with optim() / BFGS > t_bfgs <- system.time( r_bfgs <- optim(c(0,0), logLL_sum, X=some_data, + method="BFGS", hessian=TRUE) ) > > # estimation with maxLik() / BFGS > t_bfgsM <- system.time( r_bfgsM <- maxLik( logLL, start = c(0,0), + method="BFGS", X=some_data ) ) > > # estimation with maxLik() / BFGS with gradients > t_bfgsMg <- system.time( r_bfgsMg <- maxLik( logLL, d_logLL, start = c(0,0), + method="BFGS", X=some_data ) ) > > # estimation with maxLik() / BHHH > t_bhhh <- system.time( r_bhhh <- maxLik( logLL, start = c(0,0), + method="BHHH", X=some_data ) ) > > # estimation with maxLik() / BHHH with gradients > t_bhhhg <- system.time( r_bhhhg <- maxLik( logLL, d_logLL, start = c(0,0), + method="BHHH", X=some_data ) ) > > # estimation with maxLik() / NR > t_NRn <- system.time( r_NRn <- maxLik( logLL, start = c(0,0), + method="NR", X=some_data ) ) > > # estimation with maxLik() / NR with gradients > t_NRg <- system.time( r_NRg <- maxLik( logLL, d_logLL, start = c(0,0), + method="NR", X=some_data ) ) > > # estimation with maxLik() / NR with gradients and Hessian > t_NRgh <- system.time( r_NRgh <- maxLik( logLL, d_logLL, dd_logLL, start = c(0,0), + method="NR", X=some_data ) ) > > # log likelihood values > rbind(NLM=-r_nlm$minimum, + NLM_grad=-r_nlmg$minimum, + NLM_gradHess=-r_nlmgh$minimum, + BFGS=-r_bfgs$value, + maxLikBfgs = logLik( r_bfgsM ), + maxLikBfgs_grad = logLik( r_bfgsMg ), + BHHH = logLik( r_bhhh ), + BHHH_grad = logLik( r_bhhhg ), + NR_numeric= logLik( r_NRn ), + NR_grad= logLik( r_NRg ), + NR_gradHess= logLik( r_NRgh ) ) [,1] NLM -28528 NLM_grad -28528 NLM_gradHess -28528 BFGS -28528 maxLikBfgs -28528 maxLikBfgs_grad -28528 BHHH -28528 BHHH_grad -28528 NR_numeric -28528 NR_grad -28528 NR_gradHess -28528 > > > # estimated coefficients > pp <- exp(rbind(NLM=r_nlm$estimate, + NLM_grad=r_nlmg$estimate, + NLM_gradHess=r_nlmgh$estimate, + BFGS=r_bfgs$par, + maxLikBfgs = coef( r_bfgsM ), + maxLikBfgs_grad = coef( r_bfgsMg ), + BHHH = coef( r_bhhh ), + BHHH_grad = coef( r_bhhhg ), + NR_numeric= coef( r_NRn ), + NR_grad= coef( r_NRg ), + NR_gradHess= coef( r_NRgh ) )) > colnames(pp) <- c("shape_alpha", "scale_theta") > pp shape_alpha scale_theta NLM 4.961 2.021 NLM_grad 4.961 2.021 NLM_gradHess 4.961 2.021 BFGS 4.961 2.021 maxLikBfgs 4.961 2.021 maxLikBfgs_grad 4.961 2.021 BHHH 4.961 2.021 BHHH_grad 4.961 2.021 NR_numeric 4.961 2.021 NR_grad 4.961 2.021 NR_gradHess 4.961 2.021 > > > # some Hessians > -100*round(r_nlm$hessian/100,0) [,1] [,2] [1,] -55000 -49600 [2,] -49600 -49600 > round(solve(r_nlm$hessian),5) [,1] [,2] [1,] 0.00019 -0.00019 [2,] -0.00019 0.00021 > > -100*round(r_nlmg$hessian/100,0) [,1] [,2] [1,] -55000 -49600 [2,] -49600 -49600 > round(solve(r_nlmg$hessian),5) [,1] [,2] [1,] 0.00019 -0.00019 [2,] -0.00019 0.00021 > > -100*round(r_nlmgh$hessian/100,0) [,1] [,2] [1,] -55000 -49600 [2,] -49600 -49600 > round(solve(r_nlmgh$hessian),5) [,1] [,2] [1,] 0.00019 -0.00019 [2,] -0.00019 0.00021 > > -100*round(r_bfgs$hessian/100,0) [,1] [,2] [1,] -54900 -49600 [2,] -49600 -49600 > round(solve(r_bfgs$hessian),5) [,1] [,2] [1,] 0.00019 -0.00019 [2,] -0.00019 0.00021 > > 100*round(r_NRn$hessian/100,0) [,1] [,2] [1,] -54900 -49600 [2,] -49600 -49600 > round(solve(-r_NRn$hessian),5) [,1] [,2] [1,] 0.00019 -0.00019 [2,] -0.00019 0.00021 > > 100*round(r_NRg$hessian/100,0) [,1] [,2] [1,] -54900 -49600 [2,] -49600 -49600 > round(solve(-r_NRg$hessian),5) [,1] [,2] [1,] 0.00019 -0.00019 [2,] -0.00019 0.00021 > > > # standard errors > se <- exp(rbind(NLM=sqrt(diag( solve(r_nlm$hessian) )), + NLM_grad=sqrt(diag( solve(r_nlmg$hessian) )), + NLM_gradHess=sqrt(diag( solve(r_nlmgh$hessian) )), + BFGS=sqrt(diag( solve(r_bfgs$hessian) )), + maxLikBfgs = stdEr( r_bfgsM ), + maxLikBfgs_grad = stdEr( r_bfgsMg ), + BHHH = stdEr( r_bhhh ), + BHHH_grad = stdEr( r_bhhhg ), + NR_numeric= stdEr( r_NRn ), + NR_grad= stdEr( r_NRg ), + NR_gradHess= stdEr( r_NRgh ) )) > colnames(se) <- c("shape_alpha", "scale_theta") > se shape_alpha scale_theta NLM 1.014 1.015 NLM_grad 1.014 1.015 NLM_gradHess 1.014 1.015 BFGS 1.014 1.015 maxLikBfgs 1.014 1.015 maxLikBfgs_grad 1.014 1.015 BHHH 1.014 1.015 BHHH_grad 1.014 1.015 NR_numeric 1.014 1.015 NR_grad 1.014 1.015 NR_gradHess 1.014 1.015 > > # execution times > tt <- rbind(t_nlm, t_nlmg, t_nlmgh, t_bfgs, t_bfgsM, t_bfgsMg, + t_bhhh, t_bhhhg, t_NRn, t_NRg, t_NRgh ) > # tt > > proc.time() user system elapsed 15.268 0.036 15.308 maxLik/tests/finalHessian.R0000644000176200001440000000772012603115317015375 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/tests/methods.R0000644000176200001440000000067112603115317014432 0ustar liggesuserslibrary(maxLik) 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) ll <- function(x) dnorm(x, log=TRUE) for(method in c("NR", "BFGS", "BFGSR")) { cat("-- method", method, "--\n") m <- maxLik(ll, start=0, method=method, control=list(iterlim=1)) cat("MaxControl structure:\n") show(maxControl(m)) } maxLik/tests/BFGSR.Rout.save0000644000176200001440000001101612603400165015310 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. > ### 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) { + return( - t(D - (1:N) ) %*% W %*% ( D - (1:N) ) ) + } > N <- 3 > > # round gradients to increase reproducibility of the accuracy > roundGradients <- function( object ) { + object$gradient <- round( object$gradient, 3 ) + return( object ) + } > # 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) > res <- roundGradients( res ) > summary(res) -------------------------------------------- BFGSR maximization Number of iterations: 3 Return code: 2 successive function values within tolerance limit Function value: -2.306e-08 Estimates: estimate gradient [1,] 1 0 [2,] 2 0 [3,] 3 0 -------------------------------------------- > > ## b) add noice to > W <- diag(N) + matrix(runif(N*N), N, N) > # diagonal weight matrix with some noise > D <- rep(1/N, N) > res <- maxBFGSR(quadForm, start=D, tol = 1e-10 ) > res <- roundGradients( res ) > summary(res) -------------------------------------------- BFGSR maximization Number of iterations: 40 Return code: 2 successive function values within tolerance limit Function value: -3.401e-10 Estimates: estimate gradient [1,] 1 0 [2,] 2 0 [3,] 3 0 -------------------------------------------- > > ## 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) > hatNC <- roundGradients( hatNC ) > summary( hatNC ) -------------------------------------------- BFGSR maximization Number of iterations: 26 Return code: 1 gradient close to zero Function value: 1 Estimates: estimate gradient [1,] 2 0 [2,] 2 0 -------------------------------------------- > > # should converge to c(0,0). > > ## 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) > hat3CF <- roundGradients( hat3CF ) > summary( hat3CF ) -------------------------------------------- BFGSR maximization Number of iterations: 3 Return code: 2 successive function values within tolerance limit Function value: 0.004087 Estimates: estimate gradient x 3.5 -0.012 y 3.5 -0.012 z 1.0 0.008 Constrained optimization based on SUMT Return code: 1 penalty close to zero 5 outer iterations, barrier value 2.127e-09 -------------------------------------------- > > proc.time() user system elapsed 0.610 0.036 0.640 maxLik/tests/parameters_privateTest.Rout.save0000644000176200001440000006201112612770532021213 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/methods.Rout.save0000644000176200001440000000570712604623156016132 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. > 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(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) > ll <- function(x) dnorm(x, log=TRUE) > for(method in c("NR", "BFGS", "BFGSR")) { + cat("-- method", method, "--\n") + m <- maxLik(ll, start=0, method=method, control=list(iterlim=1)) + 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 > > proc.time() user system elapsed 0.450 0.032 0.474 maxLik/tests/numericGradient.R0000644000176200001440000000052412603115317016104 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/examples.R0000644000176200001440000002242112603115317014602 0ustar liggesuserslibrary( maxLik ) options(digits=4) printRounded <- function( x ) { for( i in names( x ) ) { cat ( "$", i, "\n", sep = "" ) if( is.numeric( x[[i]] ) ) { print( round( x[[i]], 3 ) ) } else { print( x[[i]] ) } cat( "\n" ) } cat( "attr(,\"class\")\n" ) print( class( x ) ) } # round gradients to increase reproducibility of the accuracy roundGradients <- function( object ) { object$gradient <- round( object$gradient, 3 ) return( object ) } ### activePar # a simple two-dimensional exponential hat f <- function(a) exp(-(a[1]-2)^2 - (a[2]-4)^2) # # maximize wrt. both parameters free <- maxNR(f, start=1:2) printRounded( free ) free <- roundGradients( free ) summary(free) # results should be close to (2,4) activePar(free) # allow only the second parameter to vary cons <- maxNR(f, start=1:2, activePar=c(FALSE,TRUE)) printRounded( cons ) cons <- roundGradients( cons ) summary(cons) # result should be around (1,4) activePar(cons) # specify fixed par in different ways cons2 <- maxNR(f, start=1:2, fixed=1) all.equal( cons[-3], cons2[-3] ) cons3 <- maxNR(f, start=1:2, fixed=c(TRUE,FALSE)) all.equal( cons[-3], cons3[-3] ) cons4 <- maxNR(f, start=c(a=1, b=2), fixed="a") cons4 <- roundGradients( cons4 ) print(summary(cons4)) all.equal( cons, cons4 ) ### compareDerivatives set.seed( 2 ) ## A simple example with sin(x)' = cos(x) f <- sin compareDerivatives(f, cos, t0=1) ## ## Example of log-likelihood of normal density. Two-parameter ## function. x <- rnorm(100, 1, 2) # generate rnorm x l <- function(b) sum(log(dnorm((x-b[1])/b[2])/b[2])) # b[1] - mu, b[2] - sigma gradl <- function(b) { c(sum(x - b[1])/b[2]^2, sum((x - b[1])^2/b[2]^3 - 1/b[2])) } compareDerivatives(l, gradl, t0=c(1,2)) ### hessian set.seed( 3 ) # 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(1000) # sample from standard normal ml <- maxLik(ll, start=c(1,1)) # ignore eventual warnings "NaNs produced in: log(x)" printRounded( ml ) print( ml ) 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 print(stdEr(ml)) # test vector of stdEr-s # # Now run the same example while fixing a[2] = 1 mlf <- maxLik(ll, start=c(1,1), activePar=c(TRUE, FALSE)) printRounded( mlf ) print( mlf ) summary(mlf) # first parameter close to 0, the second exactly 1.0 hessian(mlf) # 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 print(stdEr(mlf)) # test standard errors with fixed par ### maxBFGS set.seed( 5 ) # Maximum Likelihood estimation of the parameter of Poissonian distribution n <- rpois(100, 3) loglik <- function(l) n*log(l) - l - lfactorial(n) # we use numeric gradient a <- maxBFGS(loglik, start=1) print( a[-3] ) class( a ) a <- roundGradients( a ) summary( a ) # you would probably prefer mean(n) instead of that ;-) # Note also that maxLik is better suited for Maximum Likelihood ### logLik.maxLik set.seed( 4 ) ## 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) printRounded( a ) print( a ) ## print log likelihood value logLik( a ) ## compare with log likelihood value of summary object all.equal( logLik( a ), logLik( summary( a ) ) ) ### maxBHHH set.seed( 6 ) ## ML estimation of exponential duration model: t <- rexp(100, 2) ## Estimate with numeric gradient and hessian a <- maxBHHH(loglik, start=1, print.level=2) print( a ) a <- roundGradients( a ) summary(a) ## Estimate with analytic gradient a <- maxBHHH(loglik, gradlik, start=1) print( a ) a <- roundGradients( a ) summary(a) ### maxLik set.seed( 7 ) ## ML estimation of exponential duration model: t <- rexp(100, 2) ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1, print.level=2) printRounded( a ) print( a ) summary(a) ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1) printRounded( a ) print( a ) summary(a) ### maxNR set.seed( 8 ) ## ML estimation of exponential duration model: t <- rexp(100, 2) loglikSum <- function(theta) sum(log(theta) - theta*t) ## Note the log-likelihood and gradient are summed over observations gradlikSum <- function(theta) sum(1/theta - t) ## Estimate with numeric gradient and Hessian a <- maxNR(loglikSum, start=1, print.level=2) a <- roundGradients( a ) print( a ) summary(a) ## You would probably prefer 1/mean(t) instead ;-) ## Estimate with analytic gradient and Hessian a <- maxNR(loglikSum, gradlikSum, hesslik, start=1) a <- roundGradients( a ) print( a ) summary(a) ### maximType ## maximise two-dimensional exponential hat. Maximum is at c(2,1): f <- function(a) exp(-(a[1] - 2)^2 - (a[2] - 1)^2) m <- maxNR(f, start=c(0,0)) m <- roundGradients( m ) print( m ) summary(m) maximType(m) ## Now use BFGS maximisation. m <- maxBFGS(f, start=c(0,0)) m <- roundGradients( m ) print( m ) summary(m) maximType(m) ### Test maxNR with 0 iterations. Should perform no iterations ### Request by Yves Croissant f <- function(a) exp(-(a[1] - 2)^2 - (a[2] - 1)^2) m0 <- maxNR(f, start=c(1.1, 2.1), iterlim=0) m0 <- roundGradients( m0 ) summary(m0) ### nObs set.seed( 10 ) # Construct a simple OLS regression: x1 <- runif(100) x2 <- runif(100) y <- 3 + 4*x1 + 5*x2 + rnorm(100) m <- lm(y~x1+x2) # estimate it nObs(m) ### nParam set.seed( 11 ) # Construct a simple OLS regression: x1 <- runif(100) x2 <- runif(100) y <- 3 + 4*x1 + 5*x2 + rnorm(100) m <- lm(y~x1+x2) # estimate it summary(m) nParam(m) # you get 3 ### numericGradient # A simple example with Gaussian bell 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 have usually quite a high precision compareDerivatives(f0, gradf0, t0=1:2) # The differenc is around 1e-10 ### returnCode ## maximise the exponential bell f1 <- function(x) exp(-x^2) a <- maxNR(f1, start=2) a <- roundGradients( a ) print( a ) returnCode(a) # should be success (1 or 2) ## Now try to maximise log() function a <- maxNR(log, start=2) returnCode(a) # should give a failure (4) ### returnMessage ## maximise the exponential bell f1 <- function(x) exp(-x^2) a <- maxNR(f1, start=2) a <- roundGradients( a ) print( a ) returnMessage(a) # should be success (1 or 2) ## Now try to maximise log() function f2 <- function(x) log(x) a <- maxNR(log, start=2) returnMessage(a) # should give 'Iteration limit exceeded.' ### summary.maxLik set.seed( 15 ) ## 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 numeric gradient and hessian a <- maxLik(loglik, start=1, print.level=2) printRounded( a ) print( a ) summary(a) ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1) printRounded( a ) print( a ) summary(a) ### summary.maxim and for "gradient"/"hessian" attributes ### Test for infinity ## maximize 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 } ## Use c(0,0) as initial value. result1 <- maxNR( f, start = c(0,0) ) print( result1 ) summary( result1 ) ## Now use c(1000000, -777777) as initial value and ask for hessian result2 <- maxNR( f, start = c( 1000000, -777777)) print( result2 ) summary( result2 ) ### Test for "gradient"/"hessian" attributes. A case which converges. hub <- function(x) { v <- exp(-sum(x*x)) val <- v attr(val, "gradient") <- -2*x*v attr(val, "hessian") <- 4*(x %*% t(x))*v - diag(2*c(v, v)) val } a <- maxNR(hub, start=c(2,1)) a <- roundGradients( a ) summary( a ) ## Now test "gradient" attribute for BHHH/3-parameter probit N <- 1000 loglikProbit <- function( beta) { xb <- x %*% beta loglik <- ifelse(y == 0, pnorm( xb, log=TRUE, lower.tail=FALSE), pnorm( xb, log.p=TRUE)) grad <- ifelse(y == 0, -dnorm(xb)/pnorm(xb, lower.tail=FALSE), dnorm(xb)/pnorm(xb)) grad <- grad*x attr(loglik, "gradient") <- grad loglik } x <- runif(N) x <- cbind(x, x - runif(N), x - runif(N)) y <- x[,1] + 2*x[,2] - x[,3] + rnorm(N) > 0 summary(maxLik(loglikProbit, start=c(0,0,0), method="bhhh")) ### vcov.maxLik set.seed( 17 ) ## ML estimation of exponential duration model: t <- rexp(100, 2) ## Estimate with numeric gradient and hessian a <- maxLik(loglik, start=1, print.level=2) printRounded( a ) print( a ) round( vcov( a ), 3 ) ## Estimate with analytic gradient and hessian a <- maxLik(loglik, gradlik, hesslik, start=1) printRounded( a ) print( a ) round( vcov( a ), 3 ) print(stdEr(a)) # test single stdEr maxLik/tests/constraints.Rout.save0000644000176200001440000004441712603115317017031 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. > ### Various tests for constrained optimization > ### > options(digits=4) > > 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 <- 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 + } > > logLikMixInd <- 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 <- 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 + } > > 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 + } > ### -------------------------- > 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: 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) > 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) > print(coef(a), digits=3) [1] 0.500 -0.775 0.876 > ## No analytic gradient > cat("Inequality constraints, numeric gradient & Hessian\n") Inequality constraints, numeric gradient & Hessian > a <- maxLik(logLikMix, + start=start, + constraints=ineqCon) > print(coef(a), digits=3) [1] 0.50 -0.63 1.23 > ## 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 y + 2z = 0\n") Test for equality constraints y + 2z = 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 ) > print(summary(mlEq)) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 2 iterations Return code 1: gradient close to zero Log-Likelihood: -339.8 3 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] 0.343 0.140 2.45 0.01444 * [2,] -1.100 0.318 -3.46 0.00054 *** [3,] 0.550 0.216 2.55 0.01075 * --- 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 2.999e-09 -------------------------------------------- > ## default, individual likelihood > mlEqInd <- maxLik(logLikMixInd, start = start, constraints = eqCon ) > all.equal(coef(mlEq), coef(mlEqInd)) [1] TRUE > all.equal(stdEr(mlEq), stdEr(mlEqInd)) [1] TRUE > ## default, analytic gradient > mlEqG <- maxLik(logLikMix, grad=gradLikMix, + start = start, constraints = eqCon ) > all.equal(coef(mlEq), coef(mlEqG), tolerance=1e-6) [1] TRUE > ## default, analytic gradient, individual likelihood > mlEqGInd <- maxLik(logLikMixInd, grad=gradLikMixInd, + start = start, constraints = eqCon ) > all.equal(coef(mlEqG), coef(mlEqGInd), tolerance=1e-6) [1] TRUE > all.equal(stdEr(mlEqGInd), stdEr(mlEqGInd), tolerance=1e-6) [1] TRUE > ## default, analytic Hessian > mlEqH <- maxLik(logLikMix, grad=gradLikMix, hess=hessLikMix, + start=start, + constraints=eqCon) > all.equal(coef(mlEqG), coef(mlEqH), toleranec=1e-6) [1] TRUE > all.equal(stdEr(mlEqG), stdEr(mlEqH)) [1] TRUE > > > ## BFGS, numeric gradient > a <- maxLik(logLikMix, + start=start, method="bfgs", + constraints=eqCon, + SUMTRho0=1) > print(coef(a)) [1] 0.3425 -1.0996 0.5498 > ## BHHH, analytic gradient (numeric does not converge?) > try( maxLik(logLikMix, gradLikMix, + start=start, method="bhhh", + constraints=eqCon, + SUMTRho0=1) ) Maximum Likelihood estimation BHHH maximisation, 6 iterations Return code 2: successive function values within tolerance limit Log-Likelihood: -339.8 (3 free parameter(s)) Estimate(s): 0.3402 -1.103 0.5514 > > > ### ------------------ Now test additional parameters for the function ---- > 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) > print(coef(a)) [1] -0.9986 0.4993 > ## NR, numeric hessian > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="nr", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > print(coef(a)) [1] -0.9986 0.4993 > ## 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) > print(coef(a)) [1] -0.9986 0.4993 > ## 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) > print(coef(a)) [1] -1.0065 0.5033 > ## BHHH, analytic > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="bhhh", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > print(coef(a)) [1] -1.0065 0.5033 > ## bfgs, no analytic gradient > a <- maxLik(logLikMix2, + start=start, method="bfgs", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > print(coef(a)) [1] -1.0163 0.5082 > ## bfgs, analytic gradient > a <- maxLik(logLikMix2, + start=start, method="bfgs", + constraints=list(eqA=A, eqB=B), + iterlim=iterlim, SUMTRho0=1, rho=0.5) > print(coef(a)) [1] -1.0163 0.5082 > ## 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 > print(coef(a)) [1] -1.1210 0.5396 > ## NM, numeric > a <- maxLik(logLikMix2, + start=start, method="nm", + 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 = 4). Try setting 'SUMTTol' to 0 > print(coef(a)) [1] 0 1 > f <- function(theta) exp(-theta %*% theta) > ## NR, multiple constraints > 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)) > print(coef(a)) [1] 0.6667 0.3333 0.3333 > ## 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 ---------------- > ## > A <- matrix(c(-1, 0, + 0, 1), 2,2, byrow=TRUE) > B <- c(1,1) > start <- c(0.8, 0.9) > ## > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A, ineqB=B), + rho=0.5) > print( summary( a ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 23 iterations Return code 0: successful convergence Log-Likelihood: -337.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] -0.77 0.12 -6.3 4e-10 *** [2,] 0.88 0.13 6.7 2e-11 *** --- 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 -3.407e-05 -------------------------------------------- > ## > a <- maxLik(logLikMix2, + start=start, method="bfgs", + constraints=list(ineqA=A, ineqB=B), + rho=0.5) > print( summary( a ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation BFGS maximization, 23 iterations Return code 0: successful convergence Log-Likelihood: -337.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] -0.77 0.12 -6.3 4e-10 *** [2,] 0.88 0.13 6.7 2e-11 *** --- 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 -3.407e-05 -------------------------------------------- > ## > a <- maxLik(logLikMix2, gradLikMix2, + start=start, method="nm", + constraints=list(ineqA=A, ineqB=B), + rho=0.5) > print( summary( a ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Nelder-Mead maximization, 59 iterations Return code 0: successful convergence Log-Likelihood: -337.6 2 free parameters Estimates: Estimate Std. error t value Pr(> t) [1,] -0.77 0.12 -6.3 4e-10 *** [2,] 0.88 0.13 6.7 2e-11 *** --- 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 -3.408e-05 -------------------------------------------- > ## ---------- test vector B for inequality -------------- > 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) > coef(a) [1] -0.5894 2.0000 > # 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) > print(summary(res)) -------------------------------------------- BFGS maximization Number of iterations: 3 Return code: 1 iteration limit exceeded Function value: 0.1125 Estimates: estimate gradient [1,] 0.7696 -0.1732 [2,] 0.7696 -0.1732 [3,] 1.0000 -0.2251 Constrained optimization based on constrOptim 1 outer iterations, barrier value -0.0004159 -------------------------------------------- > > proc.time() user system elapsed 2.872 0.046 2.915 maxLik/tests/fitNormalDist_privateTest.Rout.save0000644000176200001440000054126212612770530021637 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. > ### 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/ > 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 ) > # generate a variable from normally distributed random numbers > x <- rnorm( 100, 1, 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 + 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) > 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 ) > > ## NR method > ml <- maxLik( llf, start = startVal ) > print( ml ) Maximum Likelihood estimation Newton-Raphson maximisation, 7 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( ml ), digits = 2 ) -------------------------------------------- Maximum Likelihood estimation Newton-Raphson maximisation, 7 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( ml ) mu sigma TRUE TRUE > AIC( ml ) [1] 407.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 > 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] 2 > returnMessage( ml ) [1] "successive function values within tolerance limit" > round( vcov( ml ), 3 ) mu sigma mu 0.033 0.000 sigma 0.000 0.016 > logLik( summary( ml ) ) [1] -201.6 > 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 -------------------------------------------- > all.equal( ml[-c(3,4,5,6)], mlInd[ -c(3,4,5,6,11) ], tolerance = 1e-3 ) [1] TRUE > # 3 gradient, should be close to 0, but may vary enormously in relative terms > mlInd[[11]][sample(nrow(mlInd[[11]]), 10),] mu sigma [1,] -0.49660 -0.1025 [2,] -0.41864 -0.2322 [3,] 0.02027 -0.5498 [4,] -0.10533 -0.5304 [5,] -0.24025 -0.4457 [6,] 0.33578 -0.3457 [7,] 0.44319 -0.1937 [8,] 0.45301 -0.1777 [9,] 1.02831 1.3703 [10,] 0.27760 -0.4105 > # just print a sample of 10 > nObs( mlInd ) [1] 100 > ## Marquardt (1963) correction > mlM <- maxLik( llf, start = startVal, qac="marquardt") > print(coef(mlM)) mu sigma 1.181 1.816 > 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] TRUE > mlgInd <- maxLik( llfInd, gfInd, start = startVal ) > all.equal( mlInd, mlgInd, tolerance = 1e-3 ) [1] TRUE > all.equal( mlg[ ], mlgInd[ -11 ], tolerance = 1e-3 ) [1] TRUE > 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] TRUE > 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] TRUE > 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] TRUE > 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] TRUE > > # 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] TRUE > 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 > 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 > 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 > all.equal( ml[-c(4,5,6,9,10) ], mlBHHH[ -c(4,5,6,9,10,11) ], tolerance = 1e-3 ) [1] TRUE > 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] TRUE > 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] TRUE > # 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" > all.equal( mlgBhhhH[-4], mlgBHHH[-4], tolerance = 1e-3 ) [1] TRUE > 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] TRUE > # final Hessian = usual Hessian > mlGBhhhH <- maxLik( llfGradInd, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlGBhhhH, mlgBhhhH, tolerance = 1e-3 ) [1] TRUE > > # 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] TRUE > 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] TRUE > > # with unused Hessian as attribute > mlGHBHHH <- maxLik( llfGradHessInd, start = startVal, method = "BHHH" ) > all.equal( mlGHBHHH, mlghBHHH, tolerance = 1e-3 ) [1] TRUE > # final Hessian = usual Hessian > mlGHBhhhH <- maxLik( llfGradHessInd, start = startVal, method = "BHHH", + finalHessian = TRUE ) > all.equal( mlGHBhhhH, mlghBhhhH, tolerance = 1e-3 ) [1] TRUE > > # 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] TRUE > 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 > 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.5 > logLik( mlBFGSYC ) [1] -201.6 > 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 > 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] TRUE > 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] TRUE > all.equal( mlgBFGSYC[ -c(3,9) ], mlgIndBFGSYC[ -c(3,9,11) ], tolerance = 1e-3 ) [1] "Component \"control\": Attributes: < Component \"printLevel\": Mean relative difference: 1 >" > 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] TRUE > mlGIndBFGSYC <- maxLik( llfGradInd, start = startVal, method = "BFGSR" ) > all.equal( mlGIndBFGSYC, mlgIndBFGSYC, tolerance = 1e-3 ) [1] TRUE > > # 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 >" > 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] TRUE > > # 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] TRUE > 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 > 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 > 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 > 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] TRUE > 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] TRUE > 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] TRUE > mlGIndBFGS <- maxLik( llfGradInd, start = startVal, method = "BFGS" ) > all.equal( mlGIndBFGS, mlgIndBFGS, tolerance = 1e-3 ) [1] TRUE > > # 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] TRUE > 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] TRUE > > # 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] TRUE > 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 > 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 > 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.017 > logLik( summary( mlNM ) ) [1] -201.6 > 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] TRUE > 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] TRUE > 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] TRUE > mlGIndNM <- maxLik( llfGradInd, start = startVal, method = "NM" ) > all.equal( mlGIndNM, mlgIndNM, tolerance = 1e-3 ) [1] TRUE > > # 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] TRUE > 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 > 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.1 sigma 0.1 -60.6 > logLik( mlSANN ) [1] -201.6 > 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.017 > logLik( summary( mlSANN ) ) [1] -201.6 > 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] TRUE > 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] TRUE > 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 3e-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.0214" > > > ## 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 8.1e-11 *** sigma 1.816 0.128 14.2 < 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, 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 -------------------------------------------- > # 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, 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 -------------------------------------------- > ## > # 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 8.1e-11 *** sigma 1.816 0.128 14.2 < 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, 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 -------------------------------------------- > # 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 > 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 > 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 > 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] TRUE > 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] TRUE > 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 > 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 > 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 > all.equal( mlFix[ -c( 4, 5, 6, 9, 10 ) ], mlFixBHHH[ -c( 4, 5, 6, 9, 10, 11 ) ], + tolerance = 1e-3 ) [1] TRUE > 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] TRUE > > # 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 > 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 > 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 > 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] TRUE > 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] TRUE > 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 > coef( mlFixNm ) mu sigma 1.000 1.826 > condiNumber( mlFixNm, digits = 3 ) sigma 1 > round( hessian( mlFixNm ), 1 ) mu sigma mu -30.0 -5.9 sigma -5.9 -60.0 > logLik( mlFixNm ) [1] -202.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 > 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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] TRUE > 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : one-dimensional optimization by Nelder-Mead is unreliable: use "Brent" or optimize() directly > all.equal( mlgFixNm[ ], mlgIndFixNm[ -12 ], tolerance = 1e-3 ) [1] TRUE > 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 = 1, fn = function (theta, fnOrig, gradOrig, hessOrig, : 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 > 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 > 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 > 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] TRUE > 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] TRUE > 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 > 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 > 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 > 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] TRUE > 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] TRUE > 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] TRUE > > # 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 > 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.7 > logLik( mlNmInEq ) [1] -204.5 > 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 > 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] TRUE > 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 > 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.8 -15.1 sigma -15.1 -96.1 > logLik( mlSannInEq ) [1] -204.5 > 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 > 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.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 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 > >" > > # with analytical gradients and Hessians as attributes > mlGHCon <- maxLik( llfGradHess, start = startVal, constraints = eqCon ) > all.equal( mlGHCon, mlghCon, tolerance = 1e-3 ) [1] TRUE > 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] TRUE > all.equal( mlGHCon[-c(5,6,7,9,11)], mlGCon[-c(5,6,7,9,11)], + tolerance = 1e-1 ) [1] TRUE > > > ## 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 > 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 > 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 > 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 \"constraints\": Component \"code\": Mean relative difference: 0.5" [5] "Component \"constraints\": Component \"message\": 1 string mismatch" [6] "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 \"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] TRUE > mlgBhhhConInd <- maxLik( llfInd, gfInd, start = startVal, constraints = eqCon, + method = "BHHH" ) > all.equal( mlgBhhhCon, mlgBhhhConInd, tolerance = 1e-3 ) [1] TRUE > > # 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] TRUE > 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 \"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 \"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] TRUE > all.equal( mlGHBhhhCon, mlGBhhhCon, tolerance = 1e-3 ) [1] TRUE > > > ## BFGS method with equality constraints > mlBfgsCon <- maxLik( llf, start = startVal, constraints = eqCon, + method = "BFGS" ) > print( mlBfgsCon ) Maximum Likelihood estimation BFGS maximization, 31 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, 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 -------------------------------------------- > activePar( mlBfgsCon ) mu sigma TRUE TRUE > AIC( mlBfgsCon ) [1] 413.1 > 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.6 > logLik( mlBfgsCon ) [1] -204.5 > maximType( mlBfgsCon ) [1] "BFGS maximization" > nIter( mlBfgsCon ) function 31 > 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 > all.equal( mlBfgsCon[ -c( 4, 5, 6, 9, 10 ) ], mlGCon[ -c( 4, 5, 6, 9, 10 ) ], + tolerance = 1e-3 ) [1] "Names: 2 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, list" [12] "Component 7: Lengths: 1, 5" [13] "Component 7: names for current but not for target" [14] "Component 7: Attributes: < names for target but not for current >" [15] "Component 7: Attributes: < Length mismatch: comparison on first 0 components >" > 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 > 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 > 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 > all.equal( mlNmCon[ -c( 4, 5, 6, 9, 10 ) ], mlGCon[ -c( 4, 5, 6, 9, 10 ) ], + tolerance = 1e-3 ) [1] "Names: 2 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, list" [12] "Component 7: Lengths: 1, 5" [13] "Component 7: names for current but not for target" [14] "Component 7: Attributes: < names for target but not for current >" [15] "Component 7: Attributes: < Length mismatch: comparison on first 0 components >" > 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 > 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 > 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 > 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 39.23 0.11 39.37 maxLik/tests/constraints.R0000644000176200001440000002573412603115317015345 0ustar liggesusers### Various tests for constrained optimization ### options(digits=4) 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 <- 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 } logLikMixInd <- 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 <- 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 } 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 } ### -------------------------- 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: 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) 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) print(coef(a), digits=3) ## No analytic gradient cat("Inequality constraints, numeric gradient & Hessian\n") a <- maxLik(logLikMix, start=start, constraints=ineqCon) print(coef(a), digits=3) ## NR method with inequality constraints try( maxLik(logLikMix, start = start, constraints = ineqCon, method = "NR" ) ) ## BHHH method with inequality constraints try( maxLik(logLikMix, start = start, constraints = ineqCon, method = "BHHH" ) ) ## ---------- EQUALITY CONSTRAINTS ----------------- cat("Test for equality constraints y + 2z = 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 ) print(summary(mlEq)) ## default, individual likelihood mlEqInd <- maxLik(logLikMixInd, start = start, constraints = eqCon ) all.equal(coef(mlEq), coef(mlEqInd)) all.equal(stdEr(mlEq), stdEr(mlEqInd)) ## default, analytic gradient mlEqG <- maxLik(logLikMix, grad=gradLikMix, start = start, constraints = eqCon ) all.equal(coef(mlEq), coef(mlEqG), tolerance=1e-6) ## default, analytic gradient, individual likelihood mlEqGInd <- maxLik(logLikMixInd, grad=gradLikMixInd, start = start, constraints = eqCon ) all.equal(coef(mlEqG), coef(mlEqGInd), tolerance=1e-6) all.equal(stdEr(mlEqGInd), stdEr(mlEqGInd), tolerance=1e-6) ## default, analytic Hessian mlEqH <- maxLik(logLikMix, grad=gradLikMix, hess=hessLikMix, start=start, constraints=eqCon) all.equal(coef(mlEqG), coef(mlEqH), toleranec=1e-6) all.equal(stdEr(mlEqG), stdEr(mlEqH)) ## BFGS, numeric gradient a <- maxLik(logLikMix, start=start, method="bfgs", constraints=eqCon, SUMTRho0=1) print(coef(a)) ## BHHH, analytic gradient (numeric does not converge?) try( maxLik(logLikMix, gradLikMix, start=start, method="bhhh", constraints=eqCon, SUMTRho0=1) ) ### ------------------ Now test additional parameters for the function ---- 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) print(coef(a)) ## NR, numeric hessian a <- maxLik(logLikMix2, gradLikMix2, start=start, method="nr", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) print(coef(a)) ## 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) print(coef(a)) ## 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) print(coef(a)) ## BHHH, analytic a <- maxLik(logLikMix2, gradLikMix2, start=start, method="bhhh", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) print(coef(a)) ## bfgs, no analytic gradient a <- maxLik(logLikMix2, start=start, method="bfgs", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) print(coef(a)) ## bfgs, analytic gradient a <- maxLik(logLikMix2, start=start, method="bfgs", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) print(coef(a)) ## SANN, analytic gradient a <- maxLik(logLikMix2, gradLikMix2, start=start, method="SANN", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) print(coef(a)) ## NM, numeric a <- maxLik(logLikMix2, start=start, method="nm", constraints=list(eqA=A, eqB=B), iterlim=iterlim, SUMTRho0=1, rho=0.5) print(coef(a)) f <- function(theta) exp(-theta %*% theta) ## NR, multiple constraints 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)) print(coef(a)) ## 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 ---------------- ## A <- matrix(c(-1, 0, 0, 1), 2,2, byrow=TRUE) B <- c(1,1) start <- c(0.8, 0.9) ## a <- maxLik(logLikMix2, gradLikMix2, start=start, method="bfgs", constraints=list(ineqA=A, ineqB=B), rho=0.5) print( summary( a ), digits = 2 ) ## a <- maxLik(logLikMix2, start=start, method="bfgs", constraints=list(ineqA=A, ineqB=B), rho=0.5) print( summary( a ), digits = 2 ) ## a <- maxLik(logLikMix2, gradLikMix2, start=start, method="nm", constraints=list(ineqA=A, ineqB=B), rho=0.5) print( summary( a ), digits = 2 ) ## ---------- test vector B for inequality -------------- 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) coef(a) # 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) print(summary(res)) maxLik/NAMESPACE0000644000176200001440000000367512611017353012730 0ustar liggesusersexport( "activePar" ) export( "compareDerivatives" ) export( "condiNumber" ) export( "fnSubset" ) export( "hessian" ) export( "maxBFGS" ) export( "maxBFGSR" ) export( "maxBHHH" ) export( "maxCG" ) export( "maximType" ) export( "maxLik" ) export( "maxNM" ) export( "maxNR" ) export( "maxSANN" ) export( "nIter" ) export( "numericGradient" ) export( "numericHessian" ) export( "numericNHessian" ) 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( "hessian", "default" ) S3method( "logLik", "maxLik" ) S3method( "logLik", "summary.maxLik" ) S3method( "maximType", "default" ) S3method( "maximType", "maxim" ) S3method( "nIter", "default" ) S3method( "nObs", "maxLik" ) S3method( "nParam", "maxim" ) S3method( "print", "maxLik" ) S3method( "print", "summary.maxim" ) S3method( "print", "summary.maxLik" ) 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/NEWS0000644000176200001440000002061412620011771012176 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-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/0000755000176200001440000000000012620012042011665 5ustar liggesusersmaxLik/R/nIter.R0000644000176200001440000000030212603115316013075 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/compareDerivatives.R0000644000176200001440000000566712603115316015673 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/vcov.maxLik.R0000755000176200001440000000221112620006223014214 0ustar liggesusers## maxLik vcov.maxLik <- function(object, eigentol=1e-12, ...) { ## if exists $varcovar, take it if(!is.null(object$varcovar)) return(object$varcovar) ## otherwise invert hessian activePar <- activePar(object) if(!is.null(hess <- hessian(object))) { hess <- hessian(object)[activePar, activePar,drop=FALSE] hessev <- abs(eigen(hess, symmetric=TRUE, only.values=TRUE)$values) varcovar <- matrix(0, nParam.maxim(object), nParam.maxim(object)) # this makes the fixed parameters to 0 rownames( varcovar ) <- colnames(varcovar ) <- names(coef.maxLik(object)) if(min(hessev) > (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/maxNR.R0000644000176200001440000001222712617520566013066 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=" ")) } } return( result ) } maxLik/R/maxNRCompute.R0000644000176200001440000004401412620007347014411 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/fnSubset.R0000644000176200001440000000272012603115316013613 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.R0000644000176200001440000000037212603115316014470 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.R0000644000176200001440000001242212614233357013403 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=" ")) } } return( result ) } maxLik/R/nParam.R0000644000176200001440000000040212603115316013233 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/AIC.R0000644000176200001440000000021212603115316012410 0ustar liggesusers## Akaike (and other) information criteria AIC.maxLik <- function(object, ..., k = 2) -2*logLik(object) + k*nParam(object, free=TRUE) maxLik/R/30-addControlDddot.R0000644000176200001440000000045312614213516015316 0ustar liggesusers ## Method to overwrite parameters of an existing MaxControl object addControlDddot <- function(x, ...) { ## add ... to the control dddot <- list(...) dddot <- dddot[names(dddot) %in% openParam(x)] addControlList(x, dddot) ## } setMethod("maxControl", "MaxControl", addControlDddot) maxLik/R/maxBHHH.R0000644000176200001440000000155212603115316013243 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/nObs.R0000644000176200001440000000131612603115316012723 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/maxOptim.R0000644000176200001440000002775512617527777013666 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) # attach the control parameters class(result) <- "maxim" return(result) } maxLik/R/condiNumber.R0000644000176200001440000000273112612765005014277 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/sumt.R0000644000176200001440000001751212612765474013037 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/estfun.maxLik.R0000644000176200001440000000104512603115316014551 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/10-MaxControl_class.R0000644000176200001440000001317712604621624015530 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/observationGradient.R0000644000176200001440000000053712603115316016037 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.R0000644000176200001440000000356612614233455013307 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/numericHessian.R0000644000176200001440000000543712603115316015007 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/checkBhhhGrad.R0000644000176200001440000000645412603115316014477 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/05-classes.R0000644000176200001440000000007112603115316013676 0ustar liggesusers## first to be loaded: setOldClass(c("maxLik", "maxim")) maxLik/R/print.maxLik.R0000644000176200001440000000064012603115316014401 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/checkFuncArgs.R0000644000176200001440000000215012603115316014525 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/R/hessian.R0000644000176200001440000000021012603115316013444 0ustar liggesusers## Return Hessian of an object hessian <- function(x, ...) UseMethod("hessian") hessian.default <- function(x, ...) x$hessian maxLik/R/logLikGrad.R0000644000176200001440000000414512603115316014044 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/logLik.maxLik.R0000644000176200001440000000030312603115316014462 0ustar liggesusers### Methods for accessing loglik value maximum likelihood estimates logLik.summary.maxLik <- function( object, ...) object$loglik logLik.maxLik <- function( object, ...) object$maximum maxLik/R/maxNM.R0000644000176200001440000000253512614233411013045 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/maxBFGS.R0000644000176200001440000000244212614233273013257 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/maxCG.R0000644000176200001440000000266612614233376013043 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/returnMessage.R0000644000176200001440000000036012603115316014644 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/maximType.R0000644000176200001440000000022112603115316013771 0ustar liggesusersmaximType <- function(x) UseMethod("maximType") maximType.default <- function(x) x$maximType maximType.maxim <- function(x) x$type maxLik/R/callWithoutArgs.R0000644000176200001440000000051212603115316015133 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/openParam.R0000644000176200001440000000125112603115316013742 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/numericGradient.R0000644000176200001440000000452512603115316015147 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/callWithoutSumt.R0000644000176200001440000000032412603115316015170 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/20-maxControl.R0000644000176200001440000000114012603374571014374 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/maximMessage.R0000644000176200001440000000211412603115316014437 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/maxLik.R0000644000176200001440000000616412617517265013273 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/summary.maxLik.R0000644000176200001440000000612212620006373014744 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.maxLik(object)/stdEr.maxLik(object, eigentol=eigentol) p <- 2*pnorm( -abs( t)) t[!activePar(object)] <- NA p[!activePar(object)] <- NA results <- cbind("Estimate"=coef.maxLik(object), "Std. error"=stdEr.maxLik(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/showMaxControl.R0000644000176200001440000000111112604104377015010 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/summary.maxim.R0000644000176200001440000000554612603115316014642 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/prepareFixed.R0000644000176200001440000000572612603115316014451 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/logLikHess.R0000644000176200001440000000357012603115316014072 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/logLikAttr.R0000644000176200001440000001417712603115316014107 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)) { 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/activePar.R0000644000176200001440000000061512603115316013741 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/returnCode.R0000644000176200001440000000030612603115316014132 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/bread.maxLik.R0000644000176200001440000000011312603115316014315 0ustar liggesusersbread.maxLik <- function( x, ... ) { return( vcov( x ) * nObs( x ) ) } maxLik/R/constrOptim2.R0000644000176200001440000001227612603115316014434 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 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/coef.maxLik.R0000644000176200001440000000036512603115316014165 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/zzz.R0000644000176200001440000000116212603115316012656 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/logLikFunc.R0000644000176200001440000000203612603115316014057 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/25-addControlList.R0000644000176200001440000000537412614214014015200 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/MD50000644000176200001440000001221312620121240011774 0ustar liggesusers4e62307c5bbb7c6e67535e75405bf6f7 *DESCRIPTION 521af5143387e0950efbc19ed922a253 *NAMESPACE beb0c641887b6cc4f443ccaffb3fc795 *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 64d17ba17bea697ac45de7f5ec616c47 *R/hessian.R 2bea3b2594c3a717cdce3af836c560fe *R/logLik.maxLik.R 04e1cb4987768eaf24903562d5f2f53d *R/logLikAttr.R 17dda617a86a0248d9aa8e80af6d3181 *R/logLikFunc.R 53af305a147d63a6a6125f9df1b30c7b *R/logLikGrad.R 6f5bb5dffae2175ef4b1e408283a024d *R/logLikHess.R 4a93edf08f36c69063511a11c81f4a05 *R/maxBFGS.R fc6c1a8ab23f7ce78274da4c85b25cd2 *R/maxBFGSR.R fc364bbff5c68827536c7827fcc997ad *R/maxBFGSRCompute.R fe5933fbf427415757cac7cccc7ed277 *R/maxBHHH.R dc26c765189aab53893ef20871587498 *R/maxCG.R fbd13bdfa6f2dc09a1a22bd6ee8569ba *R/maxLik.R b71d12473ef6a49f903b66a2aa2fb8b1 *R/maxNM.R 5a9270c18023b75b7013132ba2f7567c *R/maxNR.R 906d610dbe6c992237302fdb6f937b50 *R/maxNRCompute.R 6e3b7576a01483de0469e8929a80a5a7 *R/maxOptim.R 63c770407939aefb4bfd99529cf92517 *R/maxSANN.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 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 cf2ce81e76ee9b2ddbfffa06307ff28f *R/stdEr.maxLik.R 131c1768155ac15fea7db3101dea58f5 *R/sumGradients.R d9f1bc9e14143400506a5128940511c2 *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 e7620fb10d08b6da7c707a8b8f59747b *man/estfun.maxLik.Rd 812c056426e615573fe71f21ca484374 *man/fnSubset.Rd 4cb76c1ed5f2dc2508d1010893089052 *man/hessian.Rd a46367647c920af750f04adeb8471d04 *man/logLik.maxLik.Rd 8f2753d60f2bd73ccebddc24bae8a851 *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 e8e97ec18d558beb7432aa8f9532afc5 *man/maxNR.Rd 35f8dbfb6a4aefdeede7ce8f3095f441 *man/maximType.Rd 22d3768a69246b071d441f4130db0a8a *man/nIter.Rd a74b0179e0c41a659aa1c359ba4ce082 *man/nObs.Rd 9619ae8a8492398dc9280cfe608a33e7 *man/nParam.Rd 3552f1fe651edc3af0638c1ec4493b1b *man/numericGradient.Rd 3ec6b741abbe7b2f64137fec677f2877 *man/returnCode.Rd a3a8386815b17bdc8bccaff37b2df549 *man/summary.maxLik.Rd aabf99d5d55ac733ab59d1ed00349dfc *man/summary.maxim.Rd e39688cb93ce2092adca8dcb79617203 *man/sumt.Rd c9832e82bd584e5837f81a676c5e877b *man/vcov.maxLik.Rd 959afbcfd50325402deea6e22cf51022 *tests/BFGSR.R 99457734c384da2598f1b31729c97193 *tests/BFGSR.Rout.save e3927c97961bf945a4efb5bc1dd0cc7b *tests/constraints.R e7622da2da23c960292a36488548fece *tests/constraints.Rout.save c40a63023a5e8f96e6042753ff22a45c *tests/examples.R 77d12fb0d385e9bc65df54c08e0ce37c *tests/examples.Rout.save 70db31a194f4a57154ea8d6ca822dc52 *tests/finalHessian.R 97b4ff0ed6cf6613eac6fbfc1fde0552 *tests/finalHessian.Rout.save cf1a1fef59bdc054167cd31dd354fc0a *tests/fitGammaDist.R a01a8a4391ed0b470a6b111c2311b484 *tests/fitGammaDist.Rout.save 6d2bc17e239c9ca355d0299c3b5949c6 *tests/fitNormalDist_privateTest.Rout.save d50956433b82e3a47c861bf3d2b6b30c *tests/methods.R 8fdc266dab06f5409f4684a7603bd95a *tests/methods.Rout.save c1bbe611737d8fb90e93a7bac3b1be7a *tests/numericGradient.R da073867a297c038b711fda70344d2b7 *tests/numericGradient.Rout.save d0f0867ef9edb2a8d2b9c7d4fc1c9366 *tests/parameters_privateTest.Rout.save maxLik/DESCRIPTION0000644000176200001440000000156612620121240013203 0ustar liggesusersPackage: maxLik Version: 1.3-4 Date: 2015-11-08 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 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 URL: http://www.maxLik.org NeedsCompilation: no Packaged: 2015-11-09 03:33:54 UTC; siim Repository: CRAN Date/Publication: 2015-11-09 14:41:52 maxLik/man/0000755000176200001440000000000012620012042012237 5ustar liggesusersmaxLik/man/activePar.Rd0000644000176200001440000000257212604070167014470 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/summary.maxLik.Rd0000644000176200001440000000406412605603012015461 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/nIter.Rd0000644000176200001440000000206712605101354013624 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/estfun.maxLik.Rd0000644000176200001440000000312312604075266015300 0ustar liggesusers\name{estfun.maxLik} \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, ... ) } \arguments{ \item{x}{an object of class \code{maxLik}.} \item{\dots}{further arguments (currently ignored).} } \value{ Matrix of 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 before this method can be used. This method works only 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 } \seealso{\code{\link[sandwich]{estfun}}, \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 gradients evaluated at each observation library( sandwich ) head(estfun( a ), 10) ## Estimate with analytic gradient. ## Note: it returns a vector gradlik <- function(theta) 1/theta - t b <- maxLik(loglik, gradlik, start=1) head(estfun( b ), 10) } \keyword{methods} maxLik/man/maxNR.Rd0000644000176200001440000004105612614264744013606 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{ list of class "maxim" with following components: \item{maximum}{\code{fn} value at maximum (the last calculated value if not converged).} \item{estimate}{estimated parameter value.} \item{gradient}{vector, last gradient value which was calculated. Should be close to 0 if normal convergence.} \item{gradientObs}{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{code}{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{message}{ a short message, describing the \code{code}.} \item{last.step}{ 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{fixed}{logical vector, which parameters are constants.} \item{iterations}{number of iterations.} \item{type}{character string, type of maximization.} \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/maxControl.Rd0000644000176200001440000001714612611015415014674 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-internal.Rd0000644000176200001440000000104712605105164015602 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/summary.maxim.Rd0000644000176200001440000000407312605103450015350 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/maxBFGS.Rd0000644000176200001440000002127212617530561014002 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 controction 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": \item{maximum}{value of \code{fn} at maximum.} \item{estimate}{best parameter vector found.} \item{gradient}{vector, gradient at parameter value \code{estimate}.} \item{gradientObs}{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}{value of Hessian at optimum.} \item{code}{integer. Success code, 0 is success (see \code{\link{optim}}).} \item{message}{character string giving any additional information returned by the optimizer, or NULL.} \item{fixed}{logical vector indicating which parameters are treated as constants.} \item{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{type}{character string "BFGS maximisation".} \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} } } \item{control}{the optimization control parameters in the form of a \code{\link[maxLik:MaxControl-class]{MaxControl}} object.} } \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/compareDerivatives.Rd0000644000176200001440000000774212604073404016407 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/maxLik.Rd0000644000176200001440000001073012604623626013776 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/maximType.Rd0000644000176200001440000000144212604622016014516 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/returnCode.Rd0000644000176200001440000000320212605104753014653 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/condiNumber.Rd0000644000176200001440000000645612612765301015024 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/hessian.Rd0000644000176200001440000000336712604077330014206 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/logLik.maxLik.Rd0000644000176200001440000000211512604077446015217 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 } \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/vcov.maxLik.Rd0000644000176200001440000000265212605605542014754 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/maxLik-methods.Rd0000644000176200001440000000320512605104732015427 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/man/fnSubset.Rd0000644000176200001440000000506112604077065014343 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/sumt.Rd0000644000176200001440000001231312612765606013544 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/bread.maxLik.Rd0000644000176200001440000000275212604071634015053 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/nObs.Rd0000644000176200001440000000227312603115317013445 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/numericGradient.Rd0000644000176200001440000000541512605102327015664 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/maxLik-package.Rd0000644000176200001440000000702712611016072015361 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/nParam.Rd0000644000176200001440000000236112605101563013760 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}