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) } } })