Permalink
Browse files

Added forgotten example files.

  • Loading branch information...
khigia committed Jun 8, 2008
1 parent f007d93 commit 6edd0ae35a5b357dfe597a476cd368e7a6aa57a0
Showing with 64 additions and 0 deletions.
  1. +48 −0 ex/tsp.ml
  2. +16 −0 ex/tspRun.ml
View
@@ -0,0 +1,48 @@
+open Tools
+
+let shuffle_seq size =
+ let indexes = Array.init size (fun idx -> idx) in
+ let rec _shuffle arr len pos =
+ if pos < len
+ then
+ let idx = Random.int (len - pos) in
+ let cur = arr.(pos + idx) in
+ arr.(pos + idx) <- arr.(pos);
+ Seq.Cons(cur, lazy (_shuffle arr len (pos + 1)))
+ else
+ Seq.Nil
+ in
+ _shuffle indexes size 0
+
+let pair_shuffle_seq size =
+ let s1 = shuffle_seq size in
+ let s2 = shuffle_seq size in
+ Seq.cart [s1; s2;]
+
+let reversed_section tour =
+ let len = Array.length tour in
+ let rtour = Array.rev tour in
+ pair_shuffle_seq len
+ |> Seq.map (fun l -> match l with |x::y::[] -> (x,y) | _ -> failwith "error")
+ |> Seq.filter (fun (i,j) -> i <> j)
+ |> Seq.map (fun (i,j) ->
+ if i < j
+ then
+ begin
+ let sol = Array.copy tour in
+ Array.blit rtour (len - j - 1) sol i (j + 1 - i);
+ sol
+ end
+ else
+ begin
+ let sol = Array.copy rtour in
+ Array.blit tour j sol (len - i - 1) (i + 1 - j);
+ sol
+ end
+ )
+ |> Seq.filter (fun sol -> sol <> tour)
+
+let kirkpatrick_seq alpha initial =
+ let kirkpatrick alpha temperature = temperature *. alpha in
+ Seq.of_serie (kirkpatrick alpha) initial
+
View
@@ -0,0 +1,16 @@
+open Tools
+open Tsp
+
+let objective arr =
+ Array.fold_left (fun (i,sum) e -> (i + 1, sum + e * i)) (1, 0) arr
+ |> snd
+ |> float
+
+let _ =
+ let init = [|1;2;3;4;5;6;7;8;9;1;2;3;4;5;6;7;8;9;|] in
+ let cooling = kirkpatrick_seq 0.9999 10.0 in
+ let (n, sol, score) = Anneal.optimize init objective reversed_section 500000 cooling in
+ Printf.printf "%d evaluations; score=%f; sol=\n" n score;
+ Array.iter (Printf.printf "%d ") sol;
+ print_newline ()
+

0 comments on commit 6edd0ae

Please sign in to comment.