test for lbfgs

library(Rcpp)
library(microbenchmark)
library(lbfgs)
library(inline)

sourceCpp("optim_demo.cpp", verbose = F)
# Booth's function
objfun_r <- function(x, funIdx) {
    out <- switch(funIdx,
        "0" = (x[1] + 2*x[2] - 7)^2 + (2*x[1] + x[2] - 5)^2,
        "1" = 0.26*(x[1]^2 + x[2]^2) - 0.48*x[1]*x[2],
        "2" = sum(x^2)
    )
    out
}
sourceCpp("objfunExtPtr.cpp", verbose = F)

fid <- 0L
env <- new.env()
env[["funIdx"]] <- fid

# initial value
ini_x <- runif(2)
microbenchmark(
    # Method 1
    OBJ_R = optim(ini_x, objfun_r, funIdx = as.character(fid), method = "L-BFGS-B"),
    # Method 2
    OBJ_Cpp = optim(ini_x, objfun_cpp, funIdx = fid, method = "L-BFGS-B"),
    # Method 3
    OPTIM_Cpp = optim_cpp(ini_x, fid, "L-BFGS-B", 100, -c(Inf, Inf), c(Inf, Inf), c(0,0)),
    # Method 4
    libLBFGS  = optim_cpp_lbfgs(ini_x, fid),
    # Method 5
    lbfgs = lbfgs(objfunExtPtr(), gradfunExtPtr(), vars = ini_x, invisible = 1, environment = env),
    times = 10000L
)
# Unit: microseconds
#       expr    min     lq      mean median     uq       max neval
#      OBJ_R 72.557 82.505 88.219162 87.186 90.697  1471.624 10000
#    OBJ_Cpp 53.540 57.929 67.804003 59.684 66.706  3017.559 10000
#  OPTIM_Cpp  4.096  5.852 10.370776  6.730  7.607 31059.438 10000
#   libLBFGS  2.633  3.804  5.323492  4.682  5.559  1097.135 10000
#      lbfgs 43.301 47.397 52.076136 48.859 54.419  2504.393 10000

fid <- 1L
env <- new.env()
env[["funIdx"]] <- fid
# initial value
ini_x <- runif(2)
microbenchmark(
    # Method 1
    OBJ_R = optim(ini_x, objfun_r, funIdx = as.character(fid), method = "L-BFGS-B"),
    # Method 2
    OBJ_Cpp = optim(ini_x, objfun_cpp, funIdx = fid, method = "L-BFGS-B"),
    # Method 3
    OPTIM_Cpp = optim_cpp(ini_x, fid, "L-BFGS-B", 100, -c(Inf, Inf), c(Inf, Inf), c(0,0)),
    # Method 4
    libLBFGS  = optim_cpp_lbfgs(ini_x, fid),
    # Method 5
    lbfgs = lbfgs(objfunExtPtr(), gradfunExtPtr(), vars = ini_x, invisible = 1, environment = env),
    times = 10000L
)
# Unit: microseconds
#       expr    min      lq      mean median     uq       max neval
#      OBJ_R 70.803 79.2870 88.678084 85.723 89.819 12431.558 10000
#    OBJ_Cpp 54.711 58.8070 70.209299 60.855 68.754  2303.690 10000
#  OPTIM_Cpp  4.096  5.9985  8.184224  7.022  7.900  2760.391 10000
#   libLBFGS  2.634  3.8040  5.263156  4.974  5.559  1112.934 10000
#      lbfgs 43.886 48.2750 54.135582 50.030 56.467  1668.523 10000

fid <- 2L
env <- new.env()
env[["funIdx"]] <- fid
# initial value
ini_x <- runif(5)
microbenchmark(
    # Method 1
    OBJ_R = optim(ini_x, objfun_r, funIdx = as.character(fid), method = "L-BFGS-B"),
    # Method 2
    OBJ_Cpp = optim(ini_x, objfun_cpp, funIdx = fid, method = "L-BFGS-B"),
    # Method 3
    OPTIM_Cpp = optim_cpp(ini_x, fid, "L-BFGS-B", 100, -c(Inf, Inf), c(Inf, Inf), c(0,0)),
    # Method 4
    libLBFGS  = optim_cpp_lbfgs(ini_x, fid),
    # Method 5
    lbfgs = lbfgs(objfunExtPtr(), gradfunExtPtr(), vars = ini_x, invisible = 1, environment = env),
    times = 10000L
)
# Unit: microseconds
#       expr    min     lq       mean median      uq       max neval
#      OBJ_R 84.553 93.623 101.733895 99.767 103.278  1330.898 10000
#    OBJ_Cpp 79.287 86.601 107.424162 93.038  97.133 30474.299 10000
#  OPTIM_Cpp  4.389  6.145   8.116848  7.315   7.900  1220.892 10000
#   libLBFGS  2.633  4.096   5.343584  4.975   5.851  1229.376 10000
#      lbfgs 45.934 50.907  59.094102 54.418  61.732  1756.878 10000