1# Copyright (C) 2011 Jelmer Ypma. All Rights Reserved.
2# This code is published under the L-GPL.
3#
4# File:   test-banana-global.R
5# Author: Jelmer Ypma
6# Date:   8 August 2011
7#
8# Example showing how to solve the Rosenbrock Banana function
9# using a global optimization algorithm.
10#
11# Changelog:
12#   27/10/2013: Changed example to use unit testing framework testthat.
13#   12/12/2019: Corrected warnings and using updated testtthat framework (Avraham Adler)
14
15context("Banana Global")
16
17## Rosenbrock Banana objective function
18eval_f <- function(x) {
19    return(100 * (x[2] - x[1] * x[1]) ^ 2 + (1 - x[1]) ^ 2)
20}
21
22eval_grad_f <- function(x) {
23    return(c(-400 * x[1] * (x[2] - x[1] * x[1]) - 2 * (1 - x[1]),
24             200 * (x[2] - x[1] * x[1])))
25}
26
27# initial values
28x0 <- c(-1.2, 1)
29
30# lower and upper bounds
31lb <- c(-3, -3)
32ub <- c(3,  3)
33
34test_that("Test Rosenbrock Banana optimization with global optimizer NLOPT_GD_MLSL.", {
35    # Define optimizer options.
36    local_opts <- list("algorithm" = "NLOPT_LD_LBFGS",
37                       "xtol_rel"  = 1e-4)
38
39    opts <- list("algorithm"   = "NLOPT_GD_MLSL",
40                 "maxeval"    = 10000,
41                 "population" = 4,
42                 "local_opts" = local_opts )
43
44    # Solve Rosenbrock Banana function.
45    res <- nloptr(
46        x0          = x0,
47        lb          = lb,
48        ub          = ub,
49        eval_f      = eval_f,
50        eval_grad_f = eval_grad_f,
51        opts        = opts)
52
53    # Check results.
54    expect_equal(res$objective, 0.0)
55    expect_equal(res$solution, c(1.0, 1.0))
56}
57)
58
59test_that("Test Rosenbrock Banana optimization with global optimizer NLOPT_GN_ISRES.", {
60    # Define optimizer options.
61    # For unit testing we want to set the random seed for replicability.
62    opts <- list("algorithm"   = "NLOPT_GN_ISRES",
63                 "maxeval"     = 10000,
64                 "population"  = 100,
65                 "ranseed"     = 2718)
66
67    # Solve Rosenbrock Banana function.
68    res <- nloptr(
69        x0     = x0,
70        lb     = lb,
71        ub     = ub,
72        eval_f = eval_f,
73        opts   = opts)
74
75    # Check results.
76    expect_equal(res$objective, 0.0, tolerance=1e-4)
77    expect_equal(res$solution, c(1.0, 1.0), tolerance=1e-2)
78}
79)
80
81test_that("Test Rosenbrock Banana optimization with global optimizer NLOPT_GN_CRS2_LM with random seed defined.", {
82    # Define optimizer options.
83    # For unit testing we want to set the random seed for replicability.
84    opts <- list("algorithm"   = "NLOPT_GN_CRS2_LM",
85                 "maxeval"     = 10000,
86                 "population"  = 100,
87                 "ranseed"     = 2718)
88
89    # Solve Rosenbrock Banana function.
90    res1 <- nloptr(
91        x0     = x0,
92        lb     = lb,
93        ub     = ub,
94        eval_f = eval_f,
95        opts   = opts)
96
97    # Define optimizer options.
98    # this optimization uses a different seed for the
99    # random number generator and gives a different result
100    opts <- list("algorithm"   = "NLOPT_GN_CRS2_LM",
101                 "maxeval"     = 10000,
102                 "population"  = 100,
103                 "ranseed"     = 3141)
104
105    # Solve Rosenbrock Banana function.
106    res2 <- nloptr(
107        x0     = x0,
108        lb     = lb,
109        ub     = ub,
110        eval_f = eval_f,
111        opts   = opts)
112
113    # Define optimizer options.
114    # this optimization uses the same seed for the random
115    # number generator and gives the same results as res2
116    opts <- list("algorithm"   = "NLOPT_GN_CRS2_LM",
117                 "maxeval"     = 10000,
118                 "population"  = 100,
119                 "ranseed"     = 3141)
120
121    # Solve Rosenbrock Banana function.
122    res3 <- nloptr(
123        x0     = x0,
124        lb     = lb,
125        ub     = ub,
126        eval_f = eval_f,
127        opts   = opts)
128
129    # Check results.
130    expect_equal(res1$objective, 0.0, tolerance = 1e-4)
131    expect_equal(res1$solution, c(1.0, 1.0), tolerance = 1e-2)
132
133    expect_equal(res2$objective, 0.0, tolerance = 1e-4)
134    expect_equal(res2$solution, c(1.0, 1.0), tolerance = 1e-2)
135
136    expect_equal(res3$objective, 0.0, tolerance = 1e-4)
137    expect_equal(res3$solution, c(1.0, 1.0), tolerance = 1e-2)
138
139    # Expect that the results are different for res1 and res2.
140    expect_false(res1$objective == res2$objective)
141    expect_false(all(res1$solution  == res2$solution))
142
143    # Expect that the results are identical for res2 and res3.
144    expect_identical(res2$objective, res3$objective)
145    expect_identical(res2$solution, res3$solution)
146}
147)
148
149