simulated_annealing_type Derived Type

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:

  • 0 - nothing printed.
  • 1 - function value for the starting value and summary results before each temperature reduction. this includes the optimal function value found so far, the total number of moves (broken up into uphill, downhill, accepted and rejected), the number of out of bounds trials, the number of new optima found at this temperature, the current optimal x and the step length vm. note that there are nnsnt function evalutations before each temperature reduction. finally, notice is is also given upon achieveing the termination criteria.
  • 2 - each new step length (vm), the current optimal x (xopt) and the current trial x (x). this gives the user some idea about how far x strays from xopt as well as how vm is adapting to the function.
  • 3 - each function evaluation, its acceptance or rejection and new optima. for many problems, this option will likely require a small tree if hard copy is used. this option is best used to learn about the algorithm. a small value for maxevl is thus recommended when using iprint = 3.

suggested value: 1 note: for a given value of iprint, the lower valued options (other than 0) are utilized.

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.

  • 1 : original method: adjust vm so that approximately half of all evaluations are accepted
  • 2 : keep vm constant
  • 3 : adjust by a constant vms factor
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

  • 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

procedure, public :: optimize => sa

  • 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…

procedure, public :: destroy => destroy_sa

procedure, private :: func

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

procedure, private :: perturb_and_evaluate

  • 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

Source Code

    type,public :: simulated_annealing_type

        private

        integer :: n = 0              !! number of variables in the function to be optimized.
        logical :: 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(wp) :: 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  :: 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  :: nt = 100          !! number of iterations before temperature reduction. after
                                      !! nt*ns function evaluations, temperature (t) is changed
                                      !! by the factor rt.  value suggested by corana et al. is
                                      !! max(100, 5*n).  see goffe et al. for further advice.
        integer  :: neps = 4          !! number of final function values used to decide upon
                                      !! termination.  see eps.  suggested value is 4.
        integer  :: maxevl = 10000    !! the maximum number of function evaluations.  if it is
                                      !! exceeded, ier = 1.

        logical :: 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 :: n_resets = 2 !! number of times to run the main loop (must be >=1)

        real(wp), dimension(:),allocatable :: lb        !! the lower bound for the allowable solution variables.
        real(wp), 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(wp), dimension(:),allocatable :: c         !! vector that controls the step length adjustment.  the suggested
                                                        !! value for all elements is 2.0.
        integer :: iprint = 1           !! controls printing inside [[sa]]:
                                        !!
                                        !!  * 0 - nothing printed.
                                        !!  * 1 - function value for the starting value and
                                        !!    summary results before each temperature
                                        !!    reduction. this includes the optimal
                                        !!    function value found so far, the total
                                        !!    number of moves (broken up into uphill,
                                        !!    downhill, accepted and rejected), the
                                        !!    number of out of bounds trials, the
                                        !!    number of new optima found at this
                                        !!    temperature, the current optimal x and
                                        !!    the step length vm. note that there are
                                        !!    n*ns*nt function evalutations before each
                                        !!    temperature reduction. finally, notice is
                                        !!    is also given upon achieveing the termination
                                        !!    criteria.
                                        !!  * 2 - each new step length (vm), the current optimal
                                        !!    x (xopt) and the current trial x (x). this
                                        !!    gives the user some idea about how far x
                                        !!    strays from xopt as well as how vm is adapting
                                        !!    to the function.
                                        !!  * 3 - each function evaluation, its acceptance or
                                        !!    rejection and new optima. for many problems,
                                        !!    this option will likely require a small tree
                                        !!    if hard copy is used. this option is best
                                        !!    used to learn about the algorithm. a small
                                        !!    value for maxevl is thus recommended when
                                        !!    using iprint = 3.
                                        !!
                                        !! suggested value: 1
                                        !! note: for a given value of iprint, the lower valued
                                        !! options (other than 0) are utilized.
        integer :: iseed1 = 1234    !! the first seed for the random number generator.
        integer :: 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   :: step_mode = 1  !! how to vary `vm` after `ns` cycles.
                                    !!
                                    !! * 1 : original method: adjust vm so that approximately
                                    !!   half of all evaluations are accepted
                                    !! * 2 : keep vm constant
                                    !! * 3 : adjust by a constant `vms` factor
        real(wp)  :: vms = 0.1_wp         !! for `step_mode=3`, the factor to adjust `vm`
        integer   :: iunit = output_unit  !! unit number for prints.

        ! option to specify the known answer, so the solver will stop if it finds it:
        logical :: optimal_f_specified = .false. !! if the optional `f` value is known,
                                                 !! it can be specified by `optimal_f`.
        real(wp) :: optimal_f = 0.0_wp !! if `optimal_f_specified=True` the solver will stop
                                       !! if this value is achieved.
        real(wp) :: optimal_f_tol = 0.0_wp !! absolute tolerance for the `optimal_f` check

        procedure(sa_func),pointer :: fcn => null()  !! the user's function

    contains

        private

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

        procedure :: func
        procedure :: perturb_and_evaluate

    end type simulated_annealing_type