public
Description: Simulated annealing implementation in OCaml
Homepage:
Clone URL: git://github.com/khigia/ocaml-anneal.git
ocaml-anneal / anneal.ml
100644 58 lines (49 sloc) 2.133 kb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
let kirkpatrick_seq alpha initial =
    let kirkpatrick alpha temperature = temperature *. alpha in
    Seq.of_serie (kirkpatrick alpha) initial
 
 
type 'a sol =
    | Final of 'a state
    | Intermediate of 'a state
and 'a state = 'a * float * 'a * float * int
 
let acceptable temperature curS nextS =
    let p = if nextS > curS
        then 1.0
        else exp( -1.0 *. (abs_float ((nextS -. curS) /. temperature)) )
    in
    Random.float 1.0 < p
 
let rec explore temperature (current, currentScore) (best, bestScore) evalN evalMax solutions objective =
    (* seq_find ... *)
    match Seq.head solutions with
    | None ->
        Intermediate(current, currentScore, best, bestScore, evalN)
    | Some next ->
        if not (evalN < evalMax)
        then Final(current, currentScore, best, bestScore, evalN)
        else
            let nextScore = objective next in
            let newBest, newBestScore = if nextScore > bestScore
                then next, nextScore
                else best, bestScore
            in
            if acceptable temperature currentScore nextScore
            then
                Intermediate(next, nextScore, newBest, newBestScore, evalN+1)
            else
                explore temperature (current, currentScore) (newBest, newBestScore) (evalN+1) evalMax (Seq.tail solutions) objective
                
let rec cooling coolingSeq (current, currentScore) (best,bestScore) evalN evalMax explorer objectiveF =
    match Seq.head coolingSeq with
    | None ->
        (evalN, best, bestScore)
    | Some temperature ->
        begin
        let solutions = explorer current in
        match explore temperature (current, currentScore) (best, bestScore) evalN evalMax solutions objectiveF with
        | Intermediate(c,cs,b,bs,n) ->
            cooling (Seq.tail coolingSeq) (c,cs) (b,bs) n evalMax explorer objectiveF
        | Final(c,cs,b,bs,n) ->
            (n,b,bs)
        end
 
let optimize initial objective explorer evalMax coolingSeq =
    let _ = Random.self_init () in
    let cur = (initial, objective initial) in
    cooling coolingSeq cur cur 0 evalMax explorer objective