khigia / ocaml-anneal

Simulated annealing implementation in OCaml

This URL has Read+Write access

ocaml-anneal / seq.ml
3a86418f » khigia 2008-06-07 Added helper for sequence c... 1 (* Base *)
2
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 3 exception EmptySeq
4
094f5105 » khigia 2008-06-07 Basic dev env (Makefile, te... 5 type 'a t =
6 | Nil
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 7 | Cons of 'a lazy_t * 'a t lazy_t
094f5105 » khigia 2008-06-07 Basic dev env (Makefile, te... 8
9 let head seq =
10 match seq with
11 | Nil ->
12 None
13 | Cons(h, q) ->
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 14 Some (Lazy.force h)
094f5105 » khigia 2008-06-07 Basic dev env (Makefile, te... 15
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 16 let head_exn seq =
17 match seq with
18 | Nil ->
19 raise EmptySeq
20 | Cons(h, q) ->
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 21 Lazy.force h
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 22
094f5105 » khigia 2008-06-07 Basic dev env (Makefile, te... 23 let tail seq =
24 match seq with
25 | Nil ->
26 Nil
27 | Cons(h, q) ->
28 Lazy.force q
29
30
f007d930 » khigia 2008-06-08 First version of simulated ... 31 (* Transformation helpers *)
3a86418f » khigia 2008-06-07 Added helper for sequence c... 32
33 let rec of_list lst =
34 match lst with
35 | h :: q ->
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 36 Cons(lazy h, lazy (of_list q))
3a86418f » khigia 2008-06-07 Added helper for sequence c... 37 | [] ->
38 Nil
39
f007d930 » khigia 2008-06-08 First version of simulated ... 40 let to_list seq =
41 let rec _to_list seq acc =
42 match head seq with
43 | Some h ->
44 _to_list (tail seq) (h::acc)
45 | None ->
46 List.rev acc
47 in
48 _to_list seq []
49
72a59308 » khigia 2008-06-19 Added of_array function to ... 50 let of_array a =
51 let rec _of_array a pos =
52 let l = Array.length a in
53 if pos < l
54 then
55 Cons(lazy a.(pos), lazy (_of_array a (pos + 1)))
56 else
57 Nil
58 in
59 _of_array a 0
60
3a86418f » khigia 2008-06-07 Added helper for sequence c... 61
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 62 (* Manipulation *)
63
2cfe357a » khigia 2008-06-17 Added dichotomy to Seq modu... 64 let push_front e seq =
65 Cons(lazy e, lazy seq)
66
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 67 let rec map fn seq =
68 (* seq is last arg such that forward op can be used *)
69 match head seq with
70 | None ->
71 Nil
72 | Some e ->
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 73 Cons(lazy (fn e), lazy (map fn (tail seq)))
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 74
75 let rec gmap_exn fn seqs =
76 match seqs with
77 | Nil :: _ ->
78 Nil
79 | _ ->
80 let heads = List.map head_exn seqs in
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 81 Cons(lazy (fn heads), lazy (gmap_exn fn (List.map tail seqs)))
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 82
83 let rec iter fn seq =
84 match head seq with
85 | None ->
86 ()
87 | Some e ->
88 let _ = fn e in
89 iter fn (tail seq)
90
91 let rec filter pred seq =
92 match head seq with
93 | None ->
94 Nil
95 | Some h ->
96 if pred h
97 then
7c21b8b3 » khigia 2008-06-16 Fix the completely lazy Seq... 98 Cons(lazy h, lazy (filter pred (tail seq) ))
9ebe1ee4 » khigia 2008-06-08 Added tools to Seq (map, it... 99 else
100 filter pred (tail seq)
101
60087254 » khigia 2008-06-16 Added a concat function to ... 102 let rec concat seqs =
103 match head seqs with
104 | None ->
105 Nil
106 | Some h ->
107 begin
108 match h with
109 | Nil ->
110 concat (tail seqs)
111 | Cons(hh, tt) ->
112 Cons(hh, lazy (concat (Cons(lazy (tail h), lazy (tail seqs)))))
113 end
114
2cfe357a » khigia 2008-06-17 Added dichotomy to Seq modu... 115 let rec concat_list seqs =
f007d930 » khigia 2008-06-08 First version of simulated ... 116 match seqs with
117 | h :: a ->
118 begin
119 match head h with
120 | None ->
60087254 » khigia 2008-06-16 Added a concat function to ... 121 concat_list a
f007d930 » khigia 2008-06-08 First version of simulated ... 122 | Some e ->
60087254 » khigia 2008-06-16 Added a concat function to ... 123 Cons(lazy e, lazy (concat_list ((tail h) :: a)))
f007d930 » khigia 2008-06-08 First version of simulated ... 124 end
125 | [] ->
126 Nil
127
2cfe357a » khigia 2008-06-17 Added dichotomy to Seq modu... 128 let rec combine s1 s2 =
129 match head s1 with
130 | None ->
131 s2
132 | Some h ->
133 Cons(lazy h, lazy (combine s2 (tail s1)))
134
f007d930 » khigia 2008-06-08 First version of simulated ... 135 let rec cart seqs =
136 match seqs with
137 | [] ->
138 Nil
139 | h :: [] ->
140 map (fun e -> [e;]) h
141 | h :: a ->
142 match head h with
143 | None ->
144 Nil
145 | Some e ->
60087254 » khigia 2008-06-16 Added a concat function to ... 146 concat_list [
f007d930 » khigia 2008-06-08 First version of simulated ... 147 (map (fun c -> e :: c) (cart a));
148 (cart ((tail h) :: a));
149 ]
2cfe357a » khigia 2008-06-17 Added dichotomy to Seq modu... 150
151
152 (* Builder helpers *)
153
154 let rec of_serie fn n0 =
155 Cons(lazy n0, lazy (of_serie fn (fn n0)))
156
9f42c423 » khigia 2008-06-17 Added range function in Seq. 157 let rec range_int ?(step=1) a b =
158 if (step > 0 && a < b) || (step < 0 && a > b)
159 then
160 Cons(lazy a, lazy (range_int ~step:step (a + step) b))
161 else
162 Nil
163
2cfe357a » khigia 2008-06-17 Added dichotomy to Seq modu... 164 let rec dichotomy_int x y =
165 if x > y
166 then dichotomy_int y x
167 else
168 let delta = y - x in
169 if delta > 1
170 then
171 let half = x + delta / 2 in
172 Cons(lazy half, lazy (combine (dichotomy_int x half) (dichotomy_int half y)))
173 else
174 Nil
175
176
177 let rec dichotomy_float x y =
178 if x > y
179 then dichotomy_float y x
180 else
181 let half = x +. (y -. x) /. 2. in
182 Cons(lazy half, lazy (combine (dichotomy_float x half) (dichotomy_float half y)))
183