R/RcppExports.R

In roptim: General Purpose Optimization in R using C++

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#'@title Example 1: Minimize Rosenbrock function using BFGS
#'@description Minimize Rosenbrock function using BFGS.
#'@param print whether the results should be printed.
#'@examples
#'fr <- function(x) {   ## Rosenbrock Banana function
#'  x1 <- x[1]
#'  x2 <- x[2]
#'  100 * (x2 - x1 * x1)^2 + (1 - x1)^2
#'}
#'grr <- function(x) { ## Gradient of 'fr'
#'  x1 <- x[1]
#'  x2 <- x[2]
#'  c(-400 * x1 * (x2 - x1 * x1) - 2 * (1 - x1),
#'    200 *      (x2 - x1 * x1))
#'}
#'res <- optim(c(-1.2,1), fr, grr, method = "BFGS", control = list(trace=TRUE), hessian = TRUE)
#'res
#'
#'## corresponding C++ implementation:
#'example1_rosen_bfgs()
#'@export
example1_rosen_bfgs <- function(print = TRUE) {
    .Call('_roptim_example1_rosen_bfgs', PACKAGE = 'roptim', print)
}

#'@title Example 1: Minimize Rosenbrock function using other methods
#'@description Minimize Rosenbrock function using other methods ("Nelder-Mead"/"CG"/ "L-BFGS-B"/"SANN").
#'@examples
#'fr <- function(x) {   ## Rosenbrock Banana function
#'  x1 <- x[1]
#'  x2 <- x[2]
#'  100 * (x2 - x1 * x1)^2 + (1 - x1)^2
#'}
#'grr <- function(x) { ## Gradient of 'fr'
#'  x1 <- x[1]
#'  x2 <- x[2]
#'  c(-400 * x1 * (x2 - x1 * x1) - 2 * (1 - x1),
#'    200 *      (x2 - x1 * x1))
#'}
#'
#'optim(c(-1.2,1), fr)
#'
#'## These do not converge in the default number of steps
#'optim(c(-1.2,1), fr, grr, method = "CG")
#'optim(c(-1.2,1), fr, grr, method = "CG", control = list(type = 2))
#'
#'optim(c(-1.2,1), fr, grr, method = "L-BFGS-B")
#'
#'optim(c(-1.2,1), fr, method = "SANN")
#'
#'## corresponding C++ implementation:
#'example1_rosen_other_methods()
#'@export
example1_rosen_other_methods <- function() {
    invisible(.Call('_roptim_example1_rosen_other_methods', PACKAGE = 'roptim'))
}

#'@title Example 1: Gradient/Hessian checks for the implemented C++ class of Rosenbrock function
#'@description Gradient/Hessian checks for the implemented C++ class of Rosenbrock function.
#'@export
example1_rosen_grad_hess_check <- function() {
    invisible(.Call('_roptim_example1_rosen_grad_hess_check', PACKAGE = 'roptim'))
}

#'@title Example 1: Minimize Rosenbrock function (with numerical gradient) using BFGS
#'@description Minimize Rosenbrock function (with numerical gradient) using BFGS.
#'@examples
#'fr <- function(x) {   ## Rosenbrock Banana function
#'  x1 <- x[1]
#'  x2 <- x[2]
#'  100 * (x2 - x1 * x1)^2 + (1 - x1)^2
#'}
#'
#'optim(c(-1.2,1), fr, NULL, method = "BFGS")
#'
#'## corresponding C++ implementation:
#'example1_rosen_nograd_bfgs()
#'@export
example1_rosen_nograd_bfgs <- function() {
    invisible(.Call('_roptim_example1_rosen_nograd_bfgs', PACKAGE = 'roptim'))
}

#'@title Example 2: Solve Travelling Salesman Problem (TSP) using SANN
#'@description Solve Travelling Salesman Problem (TSP) using SANN.
#'@param distmat a distance matrix for storing all pair of locations.
#'@param x initial route.
#'@examples
#'## Combinatorial optimization: Traveling salesman problem
#'library(stats) # normally loaded
#'
#'eurodistmat <- as.matrix(eurodist)
#'
#'distance <- function(sq) {  # Target function
#'  sq2 <- embed(sq, 2)
#'  sum(eurodistmat[cbind(sq2[,2], sq2[,1])])
#'}
#'
#'genseq <- function(sq) {  # Generate new candidate sequence
#'  idx <- seq(2, NROW(eurodistmat)-1)
#'  changepoints <- sample(idx, size = 2, replace = FALSE)
#'  tmp <- sq[changepoints[1]]
#'  sq[changepoints[1]] <- sq[changepoints[2]]
#'  sq[changepoints[2]] <- tmp
#'  sq
#'}
#'
#'sq <- c(1:nrow(eurodistmat), 1)  # Initial sequence: alphabetic
#'distance(sq)
#'# rotate for conventional orientation
#'loc <- -cmdscale(eurodist, add = TRUE)$points
#'x <- loc[,1]; y <- loc[,2]
#'s <- seq_len(nrow(eurodistmat))
#'tspinit <- loc[sq,]
#'
#'plot(x, y, type = "n", asp = 1, xlab = "", ylab = "",
#'     main = "initial solution of traveling salesman problem", axes = FALSE)
#'arrows(tspinit[s,1], tspinit[s,2], tspinit[s+1,1], tspinit[s+1,2],
#'       angle = 10, col = "green")
#'text(x, y, labels(eurodist), cex = 0.8)
#'
#'## The original R optimization:
#'## set.seed(123) # chosen to get a good soln relatively quickly
#'## res <- optim(sq, distance, genseq, method = "SANN",
#'##              control = list(maxit = 30000, temp = 2000, trace = TRUE,
#'##              REPORT = 500))
#'## res  # Near optimum distance around 12842
#'
#'## corresponding C++ implementation:
#'set.seed(4)  # chosen to get a good soln relatively quickly
#'res <- example2_tsp_sann(eurodistmat, sq)
#'
#'tspres <- loc[res$par,]
#'plot(x, y, type = "n", asp = 1, xlab = "", ylab = "",
#'     main = "optim() 'solving' traveling salesman problem", axes = FALSE)
#'arrows(tspres[s,1], tspres[s,2], tspres[s+1,1], tspres[s+1,2],
#'       angle = 10, col = "red")
#'text(x, y, labels(eurodist), cex = 0.8)
#'@export
example2_tsp_sann <- function(distmat, x) {
    .Call('_roptim_example2_tsp_sann', PACKAGE = 'roptim', distmat, x)
}

#'@title Example 3: Minimize a function using L-BFGS-B with 25-dimensional box constrained
#'@description Minimize a function using L-BFGS-B with 25-dimensional box constrained.
#'@examples
#'flb <- function(x)
#'{ p <- length(x); sum(c(1, rep(4, p-1)) * (x - c(1, x[-p])^2)^2) }
#'## 25-dimensional box constrained
#'optim(rep(3, 25), flb, NULL, method = "L-BFGS-B",
#'      lower = rep(2, 25), upper = rep(4, 25)) # par[24] is *not* at boundary
#'
#' ## corresponding C++ implementation:
#' example3_flb_25_dims_box_con()
#'@export
example3_flb_25_dims_box_con <- function() {
    invisible(.Call('_roptim_example3_flb_25_dims_box_con', PACKAGE = 'roptim'))
}

#'@title Example 4: Minimize a "wild" function using SANN and BFGS
#'@description Minimize a "wild" function using SANN and BFGS.
#'@examples
#'## "wild" function , global minimum at about -15.81515
#'fw <- function (x)
#'  10*sin(0.3*x)*sin(1.3*x^2) + 0.00001*x^4 + 0.2*x+80
#'plot(fw, -50, 50, n = 1000, main = "optim() minimising 'wild function'")
#'
#'res <- optim(50, fw, method = "SANN",
#'             control = list(maxit = 20000, temp = 20, parscale = 20))
#'res
#'## Now improve locally {typically only by a small bit}:
#'(r2 <- optim(res$par, fw, method = "BFGS"))
#'points(r2$par,  r2$value,  pch = 8, col = "red", cex = 2)
#'
#' ## corresponding C++ implementation:
#' example4_wild_fun()
#'@export
example4_wild_fun <- function() {
    invisible(.Call('_roptim_example4_wild_fun', PACKAGE = 'roptim'))
}