tests/testthat/test_rosenbrock.R

In trustOptim: Trust Region Optimization for Nonlinear Functions with Sparse Hessians

context("Tests using Rosenbrock function")

test_that("Rosenbrock", {
  testthat::skip_on_cran()
    f.rosen <- function(V) {

        N <- length(V)/2
        x <- V[seq(1,2*N-1,by=2)]
      y <- V[seq(2,2*N,by=2)]
      return(sum(100*(x^2-y)^2+(x-1)^2))

    }

    df.rosen <- function(V) {
        N <- length(V)/2
        x <- V[seq(1,2*N-1,by=2)]
        y <- V[seq(2,2*N,by=2)]

        t <- x^2-y
        dxi <- 400*t*x+2*(x-1)
        dyi <- -200*t
        return(as.vector(rbind(dxi,dyi)))
    }

    hess.rosen <- function(V) {

        N <- length(V)/2
        x <- V[seq(1,2*N-1,by=2)]
        y <- V[seq(2,2*N,by=2)]
        d0 <- rep(200,N*2)
        d0[seq(1,(2*N-1),by=2)] <- 1200*x^2-400*y+2
        d1 <- rep(0,2*N-1)
        d1[seq(1,(2*N-1),by=2)] <- -400*x

        H <- bandSparse(2*N,
                        k=c(-1,0,1),
                        diagonals=list(d1,d0,d1),
                        symmetric=FALSE,
                        repr="C")
        return(drop0(H))
    }

    set.seed(123)
    N <- 3
    start <- as.vector(rnorm(2*N,-1,3))

    m <- list(list(hs=hess.rosen, method="Sparse", precond=0),
              list(hs=NULL, method="BFGS", precond=0),
              list(hs=NULL, method="SR1", precond=0),
              list(hs=hess.rosen, method="Sparse", precond=1)
              )

    for (meth in m) {

  if (!(Sys.info()[['sysname']] == 'sunos' & meth$method %in% c('BFGS', 'SR1'))) {

        opt0 <- trust.optim(start,
                            fn=f.rosen,
                            gr=df.rosen,
                            hs=meth$hs,
                            method=meth$method,
                            control=list(
                                preconditioner=meth$precond,
                                report.freq=5L,
                                maxit=5000L,
                                report.level=0,
                                stop.trust.radius=1e-9,
                                prec=1e-6
                            )
                            )

        norm_gr <- sqrt(sum(opt0$gradient ^ 2))
        expect_equal(norm_gr, 0,  tolerance=.0005)
        expect_match(opt0$status, "Success")
    expect_match(opt0$method, meth$method)

  }
    }
})