tests/testthat/test-genrose.R

In lbfgsb3c: Limited Memory BFGS Minimizer with Bounds on Parameters with optim() 'C' Interface

genrose.f <- function(x, gs = NULL) {
  # objective function
  ## One generalization of the Rosenbrock banana valley
  #   function (n parameters)
  n <- length(x)
  if (is.null(gs)) {
    gs = 100
  }
  fval <- 1 + sum(gs * (x[1:(n - 1)]^2 - x[2:n])^2 + (x[2:n] -
                                                        1)^2)
  return(fval)
}

genrose.g <- function(x, gs = NULL) {
  # vectorized gradient for genrose.f
  # Ravi Varadhan 2009-04-03
  n <- length(x)
  if (is.null(gs)) {
    gs = 100
  }
  gg <- as.vector(rep(0, n))
  tn <- 2:n
  tn1 <- tn - 1
  z1 <- x[tn] - x[tn1]^2
  z2 <- 1 - x[tn]
  gg[tn] <- 2 * (gs * z1 - z2)
  gg[tn1] <- gg[tn1] - 4 * gs * x[tn1] * z1
  gg
}

# Unconstrained Genrose test with gradient

nn <- 100
xx <- rep(3, nn)
lo <- -Inf
up <- Inf
test_that("100u", {
  ans100u <- lbfgsb3c(xx, genrose.f,
                      genrose.g, gs = 10)
  expect_equal(1, ans100u$value)
})


# Unconstrained Genrose test without gradient
ans100un <- lbfgsb3c(xx, genrose.f,
                     gr = NULL, gs = 10)

test_that("100u", {
  ans100un <- lbfgsb3c(xx, genrose.f,
                       gs = 10)
  expect_equal(1, ans100un$value)
})

## context("roskenbrock with 20", {

## x0 <- rep(0.1, 20)

## sol <- lbfgsb3c(x0, genrose.f, genrose.g)

## sol2 <- lbfgsb3c(x0, genrose.f, genrose.g, lower=0, upper=0.5, control=list(factr=1e20))

#optim(x0, genrose.f, genrose.g, method="L-BFGS-B", lower=0, upper=0.5)


## })