tests/testthat/test-banana.R

In n1qn1: Port of the 'Scilab' 'n1qn1' Module for Unconstrained BFGS Optimization

context("Test banana function")
test_that("banana", {
  n <- 3
  p <- 100

  fr <- function(x) {
    f <- 1.0
    for (i in 2:n) {
      f <- f + p * (x[i] - x[i - 1]**2)**2 + (1.0 - x[i])**2
    }
    f
  }

  grr <- function(x) {
    g <- double(n)
    g[1] <- -4.0 * p * (x[2] - x[1]**2) * x[1]
    if (n > 2) {
      for (i in 2:(n - 1)) {
        g[i] <- 2.0 * p * (x[i] - x[i - 1]**2) - 4.0 * p * (x[i + 1] - x[i]**2) * x[i] - 2.0 * (1.0 - x[i])
      }
    }
    g[n] <- 2.0 * p * (x[n] - x[n - 1]**2) - 2.0 * (1.0 - x[n])
    g
  }

  x <- c(1.02, 1.02, 1.02)
  eps <- 1e-3
  n <- length(x)
  niter <- 100L
  nsim <- 100L
  imp <- 3L
  nzm <- as.integer(n * (n + 13L) / 2L)
  zm <- double(nzm)

  tmp <- n1qn1(fr, grr, x, imp = 3)
  expect_equal(
    tmp,
    structure(list(value = 1, par = c(1, 1, 1), H = structure(c(799.995909385953, -399.614075225545, -0.19621349971226, -399.614075225545, 1002.59497391326, -400.319316558786, -0.19621349971226, -400.319316558786, 202.170906236328), .Dim = c(3L, 3L)), c.hess = c(799.995909385953, -399.614075225545, -0.19621349971226, 1002.59497391326, -400.319316558786, 202.170906236328, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), n.fn = 40, n.gr = 40), .Names = c("value", "par", "H", "c.hess", "n.fn", "n.gr"))
  )

  c.hess <- c(
    797.861115,
    -393.801473,
    -2.795134,
    991.271179,
    -395.382900,
    200.024349
  )
  c.hess <- c(c.hess, rep(0, 24 - length(c.hess)))

  tmp2 <- n1qn1(fr, grr, x, imp = 3, zm = tmp$c.hess)
  expect_equal(tmp2, structure(list(value = 1, par = c(1, 1, 1), H = structure(c(795.259326954969, -397.118675235952, -0.145917943058261, -397.118675235952, 1000.87266374192, -400.229407499536, -0.145917943058261, -400.229407499536, 202.157689379179), .Dim = c(3L, 3L)), c.hess = c(795.259326954969, -397.118675235952, -0.145917943058261, 1000.87266374192, -400.229407499536, 202.157689379179, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), n.fn = 33, n.gr = 33), .Names = c("value", "par", "H", "c.hess", "n.fn", "n.gr")))

  tmp3 <- n1qn1(fr, grr, x, imp = 3, zm = c.hess)
  expect_equal(tmp3, structure(list(value = 1, par = c(1, 1, 1), H = structure(c(800.030807707827, -399.878160447993, -0.0526692400192971, -399.878160447993, 1001.84045503084, -399.890537542132, -0.0526692400192971, -399.890537542132, 201.932617669621), .Dim = c(3L, 3L)), c.hess = c(800.030807707827, -399.878160447993, -0.0526692400192971, 1001.84045503084, -399.890537542132, 201.932617669621, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), n.fn = 29, n.gr = 29), .Names = c("value", "par", "H", "c.hess", "n.fn", "n.gr")))
})