Running 'bdstest.R' [1s]
  Running 'hobbs.R' [2s]
  Running 'jonesrun.R' [1s]
  Running 'maxfn.R' [1s]
  Running 'rosenbrock.R' [6s]
  Running 'run1param.R' [1s]
  Running 'simplefuntst.R' [0s]
  Running 'snsimple.R' [0s]
  Running 'snwood.R' [1s]
  Running 'ssqbtest.R' [1s]
  Running 'tfnchk.R' [0s]
  Running 'tgrchk.R' [1s]
  Running 'tkktc.R' [1s]
  Running 'trig1507.R' [1s]
Running the tests in 'tests/bdstest.R' failed.
Complete output:
  > rm(list=ls())
  > # fname<-paste(format(Sys.time(), "%Y%m%d%H%M"),"-btRvmmin.out",sep='')
  > # sink(fname, append=TRUE, split=TRUE)
  > require("optimx")
  Loading required package: optimx
  > #####################
  > 
  > # This test script illustrates the use of bounds in optimr() with the
  > # optimizers Rvmmin and L-BFGS-B, as well as a Kuhn Karush Tucker check 
  > # on the final parameters from the second optimization.
  > # Masks are tested at the very end for the two methods for which they are
  > # available. Note that they must be called via the opm() function.
  > 
  > 
  > # Simple bounds test for n=4
  > bt.f<-function(x){
  +  sum(x*x)
  + }
  > 
  > bt.g<-function(x){
  +   gg<-2.0*x
  + }
  > 
  > n<-4
  > lower<-rep(0,n)
  > upper<-lower # to get arrays set
  > bdmsk<-rep(1,n)
  > # bdmsk[(trunc(n/2)+1)]<-0
  > for (i in 1:n) { 
  +     lower[i]<-1.0*(i-1)*(n-1)/n
  +     upper[i]<-1.0*i*(n+1)/n
  + }
  > xx<-0.5*(lower+upper)
  > 
  > cat("lower bounds:")
  lower bounds:> print(lower)
  [1] 0.00 0.75 1.50 2.25
  > cat("start:       ")
  start:       > print(xx)
  [1] 0.625 1.625 2.625 3.625
  > cat("upper bounds:")
  upper bounds:> print(upper)
  [1] 1.25 2.50 3.75 5.00
  > 
  > cat("Rvmmin \n\n")
  Rvmmin 
  
  > # Note: trace set to 0 below. Change as needed to view progress. 
  > 
  > abtrvm <- optimr(xx, bt.f, bt.g, lower=lower, upper=upper, method="Rvmmin", control=list(trace=0))
  trace= 0 
  > # Note: use lower=lower etc. because there is a missing hess= argument
  > print(abtrvm)
  $par
  [1] 0.00 0.75 1.50 2.25
  
  $value
  [1] 7.875
  
  $counts
  function gradient 
         8        8 
  
  $convergence
  [1] 2
  
  $message
  [1] "Rvmminb appears to have converged"
  
  > 
  > cat("Axial search")
  Axial search> axabtrvm <- axsearch(abtrvm$par, fn=bt.f, fmin=abtrvm$value, lower, upper, bdmsk=NULL, 
  +               trace=0)
  > print(axabtrvm)
  $bestfn
  [1] 7.875
  
  $par
  [1] 0.00 0.75 1.50 2.25
  
  $details
    par0 fback fmin0     ffwd      parstep tilt roc
  1 0.00    NA 7.875 7.875000 3.666853e-07   90 Inf
  2 0.75    NA 7.875 7.875682 4.545258e-04   90 Inf
  3 1.50    NA 7.875 7.877727 9.086849e-04   90 Inf
  4 2.25    NA 7.875 7.881135 1.362844e-03   90 Inf
  
  > 
  > cat("Now force an early stop\n")
  Now force an early stop
  > abtrvm1 <- optimr(xx, bt.f, bt.g, lower=lower, upper=upper, method="Rvmmin", 
  +                   control=list(maxit=1, trace=0))
  trace= 0 
  Warning message:
  In Rvmminb(par, fn, gr, lower = lower, upper = upper, bdmsk = bdmsk,  :
    Too many gradient evaluations
  > print(abtrvm1)
  $par
  [1] 0.625 1.625 2.625 3.625
  
  $value
  [1] 8.884958
  
  $counts
  function gradient 
         2        2 
  
  $convergence
  [1] 1
  
  $message
  [1] "Rvmminb appears to have converged"
  
  > cat("Axial search")
  Axial search> axabtrvm1 <- axsearch(abtrvm1$par, fn=bt.f, fmin=abtrvm1$value, lower, upper, bdmsk=NULL, 
  +                      trace=0)
  > print(axabtrvm1)
  $bestfn
  [1] 8.884958
  
  $par
  [1] 0.625 1.625 2.625 3.625
  
  $details
     par0    fback    fmin0     ffwd      parstep      tilt          roc
  1 0.625 23.06203 8.884958 23.06297 0.0003788326 -51.34019 4.152308e-08
  2 1.625 23.05930 8.884958 23.06570 0.0009843780 -72.89727 2.687203e-06
  3 2.625 23.05416 8.884958 23.07085 0.0015899235 -79.21570 2.721735e-05
  4 3.625 23.04659 8.884958 23.07842 0.0021954689 -82.14669 1.332738e-04
  
  > 
  > 
  > cat("Maximization test\n")
  Maximization test
  > mabtrvm <- optimr(xx, bt.f, bt.g, lower=lower, upper=upper, method="Rvmmin", 
  +                  control=list(trace=1, maximize=TRUE))
  Parameter scaling:[1] 1 1 1 1
  gradient test tolerance =  6.055454e-06   fval= 23.0625 
   compare to max(abs(gn-ga))/(1+abs(fval)) =  3.374164e-12 
  admissible =  TRUE 
  maskadded =  FALSE 
  parchanged =  FALSE 
  trace= 1 
  Rvmminb -- J C Nash 2009-2015 - an R implementation of Alg 21
  Problem of size n= 4   Dot arguments:
  list()
  Initial fn= 23.0625 
  ig= 1   gnorm= 9.604686     1   1   23.0625 
  ig= 2   gnorm= 3.910222     2   2   8.884958 
  ig= 3   gnorm= 4.973974     3   3   8.435105 
  No acceptable point
  Reset to gradient search
    3   3   8.435105 
  ig= 4   gnorm= 1.964173     4   4   8.276993 
  ig= 5   gnorm= 4.537982     5   5   7.960819 
  No acceptable point
  Reset to gradient search
    5   5   7.960819 
  ig= 6   gnorm= 0.5767744     6   6   7.958167 
  ig= 7   gnorm= 4.50001     7   7   7.875022 
  No acceptable point
  Reset to gradient search
    7   7   7.875022 
  ig= 8   gnorm= 0   Seem to be done Rvmminb
  > # Note: use lower=lower etc. because there is a missing hess= argument
  > print(mabtrvm)
  $par
  [1] 0.00 0.75 1.50 2.25
  
  $value
  [1] 7.875
  
  $counts
  function gradient 
         8        8 
  
  $convergence
  [1] 2
  
  $message
  [1] "Rvmminb appears to have converged"
  
  > cat("Do NOT try axsearch() with maximize\n")
  Do NOT try axsearch() with maximize
  > cat("KKT condition check\n")
  KKT condition check
  > akktm <- kktchk(mabtrvm$par, bt.f, bt.g, hess=NULL, upper=upper, lower=lower,  maximize=TRUE, control=list(trace=0))
  Warning message:
  In kktchk(mabtrvm$par, bt.f, bt.g, hess = NULL, upper = upper, lower = lower,  :
    All parameters are constrained
  > print(akktm)
  $gmax
  [1] 0
  
  $evratio
  [1] NA
  
  $kkt1
  [1] TRUE
  
  $kkt2
  [1] TRUE
  
  $hev
  [1] 0 0 0 0
  
  $ngatend
  [1] 0.0 1.5 3.0 4.5
  
  $nhatend
       [,1] [,2] [,3] [,4]
  [1,]   -2    0    0    0
  [2,]    0   -2    0    0
  [3,]    0    0   -2    0
  [4,]    0    0    0   -2
  
  > 
  > 
  > 
  > 
  > alb<-optimr(xx,bt.f, bt.g, lower=lower, upper=upper, method="L-BFGS-B", 
  +             control=list(trace=0))
  > print(alb)
  $par
  [1] 0.00 0.75 1.50 2.25
  
  $value
  [1] 7.875
  
  $counts
  function gradient 
         2        2 
  
  $convergence
  [1] 0
  
  $message
  [1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
  
  > 
  > cat("KKT condition check\n")
  KKT condition check
  > alkkt <- kktchk(alb$par, bt.f, bt.g, hess=NULL, upper=upper, lower=lower,  maximize=FALSE, control=list(trace=0))
  Warning message:
  In kktchk(alb$par, bt.f, bt.g, hess = NULL, upper = upper, lower = lower,  :
    All parameters are constrained
  > print(alkkt)
  $gmax
  [1] 0
  
  $evratio
  [1] NA
  
  $kkt1
  [1] TRUE
  
  $kkt2
  [1] TRUE
  
  $hev
  [1] 0 0 0 0
  
  $ngatend
  [1] 0.0 1.5 3.0 4.5
  
  $nhatend
       [,1] [,2] [,3] [,4]
  [1,]    2    0    0    0
  [2,]    0    2    0    0
  [3,]    0    0    2    0
  [4,]    0    0    0    2
  
  > 
  > alhn<-optimr(xx, bt.f, lower=lower, upper=upper, method="hjn", 
  +              control=list(trace=0))
  > print(alhn)
  $par
  [1] 0.00 0.75 1.50 2.25
  
  $value
  [1] 7.875
  
  $counts
  [1] 70 NA
  
  $convergence
  [1] 0
  
  $message
  [1] NA
  
  > 
  > #sink()
  > cat("All bounded methods attempt with opm\n")
  All bounded methods attempt with opm
  > 
  > allbds <- opm(xx, bt.f, bt.g, lower=lower, upper=upper, method="ALL", control=list(trace=0))
  trace= 0 
  Error in if (any(bvec == lower) || any(bvec == upper)) { : 
    missing value where TRUE/FALSE needed
  Calls: opm -> kktchk -> bmchk
  In addition: Warning message:
  In checksolver(method, control$allmeth, control$allpkg) :
    Package minqa for method bobyqa is not available
  Execution halted
Running the tests in 'tests/hobbs.R' failed.
Complete output:
  > rm(list=ls())
  > require(optimx)
  Loading required package: optimx
  > ## Optimization test function HOBBS
  > ## ?? refs (put in .doc??)
  > ## Nash and Walker-Smith (1987, 1989) ...
  > 
  > 
  > hobbs.f<- function(x){ # # Hobbs weeds problem -- function
  +     if (abs(12*x[3]) > 500) { # check computability
  +        fbad<-.Machine$double.xmax
  +        return(fbad)
  +     }
  +     res<-hobbs.res(x)
  +     f<-sum(res*res)
  + }
  > 
  > 
  > hobbs.res<-function(x){ # Hobbs weeds problem -- residual
  + # This variant uses looping
  +     if(length(x) != 3) stop("hobbs.res -- parameter vector n!=3")
  +     y<-c(5.308, 7.24, 9.638, 12.866, 17.069, 23.192, 31.443, 38.558, 50.156, 62.948,
  +          75.995, 91.972)
  +     t<-1:12
  +     if(abs(12*x[3])>50) {
  +        res<-rep(Inf,12)
  +     } else {
  +        res<-x[1]/(1+x[2]*exp(-x[3]*t)) - y
  +     }
  + }
  > 
  > hobbs.jac<-function(x){ # Jacobian of Hobbs weeds problem
  +    jj<-matrix(0.0, 12, 3)
  +    t<-1:12
  +     yy<-exp(-x[3]*t)
  +     zz<-1.0/(1+x[2]*yy)
  +      jj[t,1] <- zz
  +      jj[t,2] <- -x[1]*zz*zz*yy
  +      jj[t,3] <- x[1]*zz*zz*yy*x[2]*t
  +    return(jj)
  + }
  > 
  > hobbs.g<-function(x){ # gradient of Hobbs weeds problem
  +     # NOT EFFICIENT TO CALL AGAIN
  +     jj<-hobbs.jac(x)
  +     res<-hobbs.res(x)
  +     gg<-as.vector(2.*t(jj) %*% res)
  +     return(gg)
  + }
  > 
  > 
  > hobbs.rsd<-function(x) { # Jacobian second derivative
  +     rsd<-array(0.0, c(12,3,3))
  +     t<-1:12
  +     yy<-exp(-x[3]*t)
  +     zz<-1.0/(1+x[2]*yy)
  +     rsd[t,1,1]<- 0.0
  +     rsd[t,2,1]<- -yy*zz*zz
  +     rsd[t,1,2]<- -yy*zz*zz
  +     rsd[t,2,2]<- 2.0*x[1]*yy*yy*zz*zz*zz
  +     rsd[t,3,1]<- t*x[2]*yy*zz*zz
  +     rsd[t,1,3]<- t*x[2]*yy*zz*zz
  +     rsd[t,3,2]<- t*x[1]*yy*zz*zz*(1-2*x[2]*yy*zz)
  +     rsd[t,2,3]<- t*x[1]*yy*zz*zz*(1-2*x[2]*yy*zz)
  + ##    rsd[t,3,3]<- 2*t*t*x[1]*x[2]*x[2]*yy*yy*zz*zz*zz
  +     rsd[t,3,3]<- -t*t*x[1]*x[2]*yy*zz*zz*(1-2*yy*zz*x[2])
  +     return(rsd)
  + }
  > 
  > 
  > hobbs.h <- function(x) { ## compute Hessian
  + #   cat("Hessian not yet available\n")
  + #   return(NULL)
  +     H<-matrix(0,3,3)
  +     res<-hobbs.res(x)
  +     jj<-hobbs.jac(x)
  +     rsd<-hobbs.rsd(x)
  + ##    H<-2.0*(t(res) %*% rsd + t(jj) %*% jj)
  +     for (j in 1:3) {
  +        for (k in 1:3) {
  +           for (i in 1:12) {
  +              H[j,k]<-H[j,k]+res[i]*rsd[i,j,k]
  +           }
  +        }
  +     }
  +     H<-2*(H + t(jj) %*% jj)
  +     return(H)
  + }
  > 
  > 
  > 
  > x0 <- c(200, 50, .3)
  > # This start seems to be OK for all methods
  > cat("Start for Hobbs:")
  Start for Hobbs:> print(x0)
  [1] 200.0  50.0   0.3
  > cat("Initial value of hobbs.f = ",hobbs.f(x0),"\n")
  Initial value of hobbs.f =  158.2324 
  > ahobb0 <- opm(x0, hobbs.f, hobbs.g, hess=hobbs.h, method="ALL")
  This problem is unconstrained.
  Error in if (abs(12 * x[3]) > 500) { : 
    missing value where TRUE/FALSE needed
  Calls: opm -> kktchk -> fn
  In addition: Warning messages:
  1: In Rcgminu(par = spar, fn = efn, gr = egr, control = mcontrol, ...) :
    Rcgmin - undefined function
  2: In Rcgminu(par = spar, fn = efn, gr = egr, control = mcontrol, ...) :
    Rcgmin - undefined function
  3: In Rcgminu(par = spar, fn = efn, gr = egr, control = mcontrol, ...) :
    Rcgmin - undefined function
  4: In Rcgminu(par = spar, fn = efn, gr = egr, control = mcontrol, ...) :
    Rcgmin - undefined function
  5: In Rcgminu(par = spar, fn = efn, gr = egr, control = mcontrol, ...) :
    Rcgmin - undefined function
  6: In checksolver(method, control$allmeth, control$allpkg) :
    Package minqa for method newuoa is not available
  Execution halted
Running the tests in 'tests/jonesrun.R' failed.
Complete output:
  > require(optimx)
  Loading required package: optimx
  > # test function from book by Owen Jones et al
  > 
  > # function is 2 variables to be maximized
  > #  f(x,y)=sin(x^2/2 - y^2/4)*cos(2x-exp(y))
  > 
  > # ?? seems to have unstable parameter 1
  > 
  > jones<-function(xx){
  +    x<-xx[1]
  +    y<-xx[2]
  +    ff<-sin(x*x/2 - y*y/4)*cos(2*x-exp(y))
  +    ff<- -ff
  + }
  > 
  > jonesg <- function(xx) {
  +    x<-xx[1]
  +    y<-xx[2]
  +    gx <-  cos(x * x/2 - y * y/4) * ((x + x)/2) * cos(2 * x - exp(y)) - 
  +          sin(x * x/2 - y * y/4) * (sin(2 * x - exp(y)) * 2)
  +    gy <- sin(x * x/2 - y * y/4) * (sin(2 * x - exp(y)) * exp(y)) - cos(x * 
  +           x/2 - y * y/4) * ((y + y)/4) * cos(2 * x - exp(y))
  +    gg <- - c(gx, gy)
  + }
  > 
  > # Note: No hessian, so newton methods will fail
  > 
  > xx<-0.5*c(pi,pi)
  > ans<-opm(xx, jones, jonesg, method="ALL", control=list(trace=0))
  This problem is unconstrained.
  Error in if (any(bvec == lower) || any(bvec == upper)) { : 
    missing value where TRUE/FALSE needed
  Calls: opm -> kktchk -> bmchk
  In addition: Warning messages:
  1: In optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
    Note: snewton needs Hessian function (hess) specified
  2: In optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
    Note: snewtonm needs Hessian function specified
  3: In checksolver(method, control$allmeth, control$allpkg) :
    Package minqa for method newuoa is not available
  Execution halted
Running the tests in 'tests/ssqbtest.R' failed.
Complete output:
  > require(optimx)
  Loading required package: optimx
  > ssqb.f<-function(x){
  +   nn<-length(x)
  +   yy <- 1:nn
  +   f<-sum((yy-x)^2)
  +   f
  + }
  > ssqb.g <- function(x){
  +   nn<-length(x)
  +   yy<-1:nn
  +   gg<- 2*(x - yy)
  + }
  > ssqb.h <- function(x){
  +   nn<-length(x)
  +   hh<- 2*diag(nn)
  + }
  > xx <- rep(pi, 4)
  > all4b <- opm(xx, ssqb.f, ssqb.g, hess=ssqb.h, method="ALL")
  This problem is unconstrained.
  Small gradient
  Error in if (any(bvec == lower) || any(bvec == upper)) { : 
    missing value where TRUE/FALSE needed
  Calls: opm -> kktchk -> bmchk
  In addition: Warning message:
  In checksolver(method, control$allmeth, control$allpkg) :
    Package minqa for method newuoa is not available
  Execution halted
Running the tests in 'tests/trig1507.R' failed.
Complete output:
  > require(optimx)
  Loading required package: optimx
  > ## Trig function
  > # ref??
  > 
  > trig.f <- function(x){
  +   res <- trig.res(x)
  +   f <- sum(res*res)
  + #  cat("FV=",f," at ")
  + #  print(x)
  +   f
  + }
  > 
  > trig.res <- function(x){
  +    n <- length(x)
  +    i <- 1:n
  +    res <- n - sum(cos(x)) + i*(1 - cos(x)) - sin(x) 
  +    return(res)
  + }
  > 
  > trig.jac <- function(x) { # not vectorized. Can it be?
  + ## stop("Not defined")
  +    n <- length(x)
  +    J<-matrix(0,n,n)
  +    for (i in 1:n) {
  +       for (j in 1:n) {
  +          J[i,j]<-sin(x[j]) # we overwrite J[i,i]
  +       }
  +       J[i,i] <- (1+i) * sin(x[i])  - cos(x[i])
  +    }
  +    return(J)
  + }
  > 
  > 
  > trig.g <- function(x) { # unvectorized
  +   n<-length(x)
  +   res<-trig.res(x)
  +   J<-trig.jac(x)
  +   g<- as.vector(2.0 * ( t(J) %*% res ))
  +   return(g)
  + }
  > 
  > 
  > x<-rep(2,2)
  > cat("opm\n")
  opm
  > opt2<-optimr(x, trig.f, trig.g, method="BFGS")
  > opt2
  $par
  [1]  0.2430642 -5.6705092
  
  $value
  [1] 2.380239e-19
  
  $counts
  function gradient 
        21       16 
  
  $convergence
  [1] 0
  
  $message
  NULL
  
  > opt2r<-optimr(x, trig.f, trig.g, method="Rvmmin")
  > opt2r
  $par
  [1]  5.720345e-17 -6.283185e+00
  
  $value
  [1] 6.325866e-32
  
  $counts
  function gradient 
        24       21 
  
  $convergence
  [1] 2
  
  $message
  [1] "Rvmminu appears to have converged"
  
  > cat("====================")
  ====================> x<-rep(2,4)
  > cat("optim(BFGS) vs optimr(BFGS)\n")
  optim(BFGS) vs optimr(BFGS)
  > opt4<-optim(x, trig.f, trig.g, method="BFGS")
  > opt4
  $par
  [1] -113.09734 -100.53096  -94.24778 -219.91149
  
  $value
  [1] 1.357942e-27
  
  $counts
  function gradient 
        29       21 
  
  $convergence
  [1] 0
  
  $message
  NULL
  
  > opt4r<-optimr(x, trig.f, trig.g, method="Rvmmin")
  > opt4r
  $par
  [1] -113.09734 -100.53096  -94.24778 -219.91149
  
  $value
  [1] 2.089786e-28
  
  $counts
  function gradient 
        28       23 
  
  $convergence
  [1] 0
  
  $message
  [1] "Rvmminu appears to have converged"
  
  > cat("====================")
  ====================> x<-rep(2,8)
  > cat("optim(BFGS) vs Rvmmin\n")
  optim(BFGS) vs Rvmmin
  > opt8<-optim(x, trig.f, trig.g, method="BFGS")
  > opt8
  $par
  [1] -301.5441 -314.1092 -301.5413 -339.2388 -376.9359 -508.6652 -527.7272
  [8] -672.2369
  
  $value
  [1] 5.506742e-19
  
  $counts
  function gradient 
        81       45 
  
  $convergence
  [1] 0
  
  $message
  NULL
  
  > opt8r<-optimr(x, trig.f, trig.g, method="Rvmmin")
  > opt8r
  $par
  [1] -301.5420 -314.1070 -301.5390 -339.2362 -376.9332 -508.8774 -527.5676
  [8] -672.1203
  
  $value
  [1] 2.036768e-27
  
  $counts
  function gradient 
       107       84 
  
  $convergence
  [1] 0
  
  $message
  [1] "Rvmminu appears to have converged"
  
  > 
  > 
  > 
  > 
  > 
  > ttrig2<-opm(rep(2,2), trig.f, trig.g, method="ALL")
  This problem is unconstrained.
  Error in if (any(bvec == lower) || any(bvec == upper)) { : 
    missing value where TRUE/FALSE needed
  Calls: opm -> kktchk -> bmchk
  In addition: Warning messages:
  1: In optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
    Note: snewton needs Hessian function (hess) specified
  2: In optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
    Note: snewtonm needs Hessian function specified
  3: In checksolver(method, control$allmeth, control$allpkg) :
    Package minqa for method newuoa is not available
  Execution halted