simulated_annealing_module Module

simulated annealing is a global optimization method that distinguishes between different local optima. starting from an initial point, the algorithm takes a step and the function is evaluated. when minimizing a function, any downhill step is accepted and the process repeats from this new point. an uphill step may be accepted. thus, it can escape from local optima. this uphill decision is made by the metropolis criteria. as the optimization process proceeds, the length of the steps decline and the algorithm closes in on the global optimum. since the algorithm makes very few assumptions regarding the function to be optimized, it is quite robust with respect to non-quadratic surfaces. the degree of robustness can be adjusted by the user. in fact, simulated annealing can be used as a local optimizer for difficult functions.

Reference

  • corana et al., "minimizing multimodal functions of continuous variables with the "simulated annealing" algorithm", september 1987 (vol. 13, no. 3, pp. 262-280), acm transactions on mathematical software.
  • goffe, ferrier and rogers, "global optimization of statistical functions with simulated annealing", journal of econometrics, vol. 60, no. 1/2, jan./feb. 1994, pp. 65-100.

History

  • based on reference by bill goffe : 1/22/94, version: 3.2 See: https://www.netlib.org/opt/simann.f
  • modifications by alan miller : fortran 90 version - 2 october 2013
  • Jacob Williams, 8/26/2019 : modernized Fortran

TODO

  • input rand distributation option
  • a way to specify that some variables are not to be changed... this could be part of the distributation selection (a constant option). each variable can have a different distribution.
  • get ideas from: https://docs.scipy.org/doc/scipy/reference/generated/scipy.optimize.basinhopping.html

Uses

  • module~~simulated_annealing_module~~UsesGraph module~simulated_annealing_module simulated_annealing_module iso_fortran_env iso_fortran_env module~simulated_annealing_module->iso_fortran_env

Variables

Type Visibility Attributes Name Initial
integer, private, parameter :: wp = real64

real kind used by this module [8 bytes]

integer, public, parameter :: simann_wp = wp

for exporting from the module


Abstract Interfaces

abstract interface

  • private subroutine sa_func(me, x, f, istat)

    interface to function to be maximized/minimized

    Arguments

    Type IntentOptional Attributes Name
    class(simulated_annealing_type), intent(inout) :: me
    real(kind=wp), intent(in), dimension(:) :: x
    real(kind=wp), intent(out) :: f
    integer, intent(out) :: istat

    status flag:

    • 0 : valid function evaluation
    • -1 : invalid function evaluation. try a different input vector.
    • -2 : stop the optimization process

Derived Types

type, public ::  simulated_annealing_type

Components

Type Visibility Attributes Name Initial
integer, private :: n = 0

number of variables in the function to be optimized.

logical, private :: maximize = .false.

denotes whether the function should be maximized or minimized. a true value denotes maximization while a false value denotes minimization. intermediate output (see iprint) takes this into account.

real(kind=wp), private :: eps = 1.0e-9_wp

error tolerance for termination. if the final function values from the last neps temperatures differ from the corresponding value at the current temperature by less than eps and the final function value at the current temperature differs from the current optimal function value by less than eps, execution terminates and ier = 0 is returned.

integer, private :: ns = 20

number of cycles. after ns function evaluations, each element of vm is adjusted according to the input step_mode the suggested value is 20.

integer, private :: nt = 100

number of iterations before temperature reduction. after ntns function evaluations, temperature (t) is changed by the factor rt. value suggested by corana et al. is max(100, 5n). see goffe et al. for further advice.

integer, private :: neps = 4

number of final function values used to decide upon termination. see eps. suggested value is 4.

integer, private :: maxevl = 10000

the maximum number of function evaluations. if it is exceeded, ier = 1.

logical, private :: use_initial_guess = .true.

if false, the initial guess is ignored and a random point in the bounds is used for the first function evaluation

integer, private :: n_resets = 2

number of times to run the main loop (must be >=1)

real(kind=wp), private, dimension(:), allocatable :: lb

the lower bound for the allowable solution variables.

real(kind=wp), private, dimension(:), allocatable :: ub

the upper bound for the allowable solution variables. if the algorithm chooses x(i) < lb(i) or x(i) > ub(i), i = 1, n, a point is from inside is randomly selected. this this focuses the algorithm on the region inside ub and lb. unless the user wishes to concentrate the search to a particular region, ub and lb should be set to very large positive and negative values, respectively. note that the starting vector x should be inside this region. also note that lb and ub are fixed in position, while vm is centered on the last accepted trial set of variables that optimizes the function.

real(kind=wp), private, dimension(:), allocatable :: c

vector that controls the step length adjustment. the suggested value for all elements is 2.0.

integer, private :: iprint = 1

controls printing inside sa:

Read more…
integer, private :: iseed1 = 1234

the first seed for the random number generator.

integer, private :: iseed2 = 5678

the second seed for the random number generator. different values for iseed1 and iseed2 will lead to an entirely different sequence of trial points and decisions on downhill moves (when maximizing). see goffe et al. on how this can be used to test the results of sa.

integer, private :: step_mode = 1

how to vary vm after ns cycles.

Read more…
real(kind=wp), private :: vms = 0.1_wp

for step_mode=3, the factor to adjust vm

integer, private :: iunit = output_unit

unit number for prints.

logical, private :: optimal_f_specified = .false.

if the optional f value is known, it can be specified by optimal_f.

real(kind=wp), private :: optimal_f = 0.0_wp

if optimal_f_specified=True the solver will stop if this value is achieved.

real(kind=wp), private :: optimal_f_tol = 0.0_wp

absolute tolerance for the optimal_f check

procedure(sa_func), private, pointer :: fcn => null()

the user's function

Type-Bound Procedures

procedure, public :: initialize => initialize_sa
procedure, public :: optimize => sa
procedure, public :: destroy => destroy_sa
procedure, private :: func
procedure, private :: perturb_and_evaluate

Functions

private pure function func(me, f)

if the function is to be minimized, switch the sign of the function. note that all intermediate and final output switches the sign back to eliminate any possible confusion for the user.

Arguments

Type IntentOptional Attributes Name
class(simulated_annealing_type), intent(in) :: me
real(kind=wp), intent(in) :: f

Return Value real(kind=wp)

private pure function exprep(x) result(f)

this function replaces exp() to avoid underflow and overflow.

Read more…

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: x

Return Value real(kind=wp)

private function uniform_random_number() result(f)

Get a new uniform random number from [0,1].

Read more…

Arguments

None

Return Value real(kind=wp)

private function uniform(xl, xu)

Uniform random number on the interval [xl,xu].

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: xl

lower bound

real(kind=wp), intent(in) :: xu

upper bound

Return Value real(kind=wp)


Subroutines

private subroutine destroy_sa(me)

Destructor.

Arguments

Type IntentOptional Attributes Name
class(simulated_annealing_type), intent(out) :: me

private subroutine initialize_sa(me, fcn, n, lb, ub, c, maximize, eps, ns, nt, neps, maxevl, iprint, iseed1, iseed2, step_mode, vms, iunit, use_initial_guess, n_resets, optimal_f_specified, optimal_f, optimal_f_tol)

Initialize the class.

Read more…

Arguments

Type IntentOptional Attributes Name
class(simulated_annealing_type), intent(inout) :: me
procedure(sa_func) :: fcn
integer, intent(in) :: n
real(kind=wp), intent(in), dimension(n) :: lb
real(kind=wp), intent(in), dimension(n) :: ub
real(kind=wp), intent(in), optional, dimension(n) :: c
logical, intent(in), optional :: maximize
real(kind=wp), intent(in), optional :: eps
integer, intent(in), optional :: ns
integer, intent(in), optional :: nt
integer, intent(in), optional :: neps
integer, intent(in), optional :: maxevl
integer, intent(in), optional :: iprint
integer, intent(in), optional :: iseed1
integer, intent(in), optional :: iseed2
integer, intent(in), optional :: step_mode
real(kind=wp), intent(in), optional :: vms
integer, intent(in), optional :: iunit
logical, intent(in), optional :: use_initial_guess
integer, intent(in), optional :: n_resets
logical, intent(in), optional :: optimal_f_specified

if the optional f value is known, it can be specified by optimal_f. [Default is False]

real(kind=wp), intent(in), optional :: optimal_f

if optimal_f_specified=True the solver will stop if this value is achieved.

real(kind=wp), intent(in), optional :: optimal_f_tol

absolute tolerance for the optimal_f check

private subroutine sa(me, x, rt, t, vm, xopt, fopt, nacc, nfcnev, ier)

Continuous simulated annealing global optimization algorithm

Read more…

Arguments

Type IntentOptional Attributes Name
class(simulated_annealing_type), intent(inout) :: me
real(kind=wp), intent(inout), dimension(me%n) :: x

on input: the starting values for the variables of the function to be optimized. [Will be replaced by final point]

real(kind=wp), intent(in) :: rt

the temperature reduction factor. the value suggested by corana et al. is .85. see goffe et al. for more advice.

real(kind=wp), intent(inout) :: t

on input, the initial temperature. see goffe et al. for advice. on output, the final temperature. Note that if t=0, then all downhill steps will be rejected

real(kind=wp), intent(inout), dimension(me%n) :: vm

the step length vector. on input it should encompass the region of interest given the starting value x. for point x(i), the next trial point is selected is from x(i) - vm(i) to x(i) + vm(i). since vm is adjusted so that about half of all points are accepted, the input value is not very important (i.e. is the value is off, sa adjusts vm to the correct value).

real(kind=wp), intent(out), dimension(me%n) :: xopt

the variables that optimize the function.

real(kind=wp), intent(out) :: fopt

the optimal value of the function.

integer, intent(out) :: nacc

the number of accepted function evaluations.

integer, intent(out) :: nfcnev

the total number of function evaluations. in a minor point, note that the first evaluation is not used in the core of the algorithm; it simply initializes the algorithm.

integer, intent(out) :: ier

the error return number:

Read more…

private subroutine perturb_and_evaluate(me, x, vm, xp, fp, nfcnev, ier, first)

Perturb the x vector and evaluate the function.

Read more…

Arguments

Type IntentOptional Attributes Name
class(simulated_annealing_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(:) :: x

input optimization variable vector to perturb

real(kind=wp), intent(in), dimension(:) :: vm

step length vector

real(kind=wp), intent(out), dimension(:) :: xp

the perturbed x value

real(kind=wp), intent(out) :: fp

the value of the user function at xp

integer, intent(inout) :: nfcnev

total number of function evaluations

integer, intent(inout) :: ier

status output code

logical, intent(in), optional :: first

to use the input x the first time

private subroutine rand_init(seed1, seed2)

Initialize the intrinsic random number generator.

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: seed1

the first seed for the random number generator.

integer, intent(in) :: seed2

the second seed for the random number generator.

public subroutine print_vector(iunit, vector, ncols, name)

this subroutine prints the double precision vector named vector. elements 1 thru ncols will be printed. name is a character variable that describes vector. note that if name is given in the call to print_vector, it must be enclosed in quotes. if there are more than 10 elements in vector, 10 elements will be printed on each line.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: iunit
real(kind=wp), intent(in), dimension(ncols) :: vector
integer, intent(in) :: ncols
character(len=*), intent(in) :: name