@@ -1,3 +1,9 @@ + +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 anneal.ml @@ -42,7 +42,32 @@ let reversed_section tour = ) |> Seq.filter (fun sol -> sol <> tour) -let kirkpatrick_seq alpha initial = - let kirkpatrick alpha temperature = temperature *. alpha in - Seq.of_serie (kirkpatrick alpha) initial +module LatLon = struct + + let pi = acos (-. 1.) + + let radians deg = + deg *. pi /. 180. + + let degrees rad = + 180. *. rad /. pi + + let _haversine (lat1d, lon1d) (lat2d, lon2d) = + let lat1 = radians lat1d in + let lon1 = radians lon1d in + let lat2 = radians lat2d in + let lon2 = radians lon2d in + let dLat_2_sin = sin ( (lat2 -. lat1) /. 2. ) in + let dLon_2_sin = sin ( (lon2 -. lon1) /. 2. ) in + let a = + dLat_2_sin *. dLat_2_sin + +. (cos lat1) *. (cos lat2) *. dLon_2_sin *. dLon_2_sin + in + let c = 2. *. (atan2 (sqrt a) (sqrt (1. -. a))) in + 6371000. *. c + + let distance p1 p2 = + if p1 = p2 then 0. else _haversine p1 p2 + +end (* module LatLon *) ex/tsp.ml @@ -1,6 +1,54 @@ open Tools open Tsp +let positions = Hashtbl.create 1000 +let distances = Hashtbl.create 1000 + +let locate pt = + Hashtbl.find positions pt + +let distance p1 p2 = + let key = if p1 < p2 then (p1, p2) else (p2, p1) in + try + Hashtbl.find distances key + with + | Not_found -> + (* TODO from p1 to position p1*) + let loc1 = locate p1 in + let loc2 = locate p2 in + let d = Tsp.LatLon.distance loc1 loc2 in + Hashtbl.replace distances key d; + d + +let read_positions buf = + let hdr = "Reading locations: " in + let rec _read_loop () = + begin + try + Scanf.bscanf buf "%d %f %f%s@\n" (fun pt lat lon _ -> + Hashtbl.replace positions pt (lat, lon) + ) + with + | Scanf.Scan_failure msg -> + Scanf.bscanf buf "%s@\n" (fun s -> + Printf.eprintf "%sskiping line: %s\n" hdr s + ) + end; + _read_loop () + in + try _read_loop () with | End_of_file -> + Printf.eprintf "%sdone.\n" hdr; + flush_all () + +let path_length pts = + Array.fold_left + (fun (cur, acc) pt -> (pt, acc +. (distance cur pt))) + (pts.(0), 0.) + pts + |> snd + + + (* let objective arr = Array.fold_left (fun (i,sum) e -> (i + 1, sum + e * i)) (1, 0) arr |> snd @@ -8,9 +56,51 @@ let objective arr = 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 cooling = Anneal.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 () + *) + +let _ = + let posfn = ref "coords.txt" in + let usage = Printf.sprintf "Usage: %s [-help] [-coords filename]" Sys.argv.(0) in + Arg.parse + [ + ("-coords", + Arg.String ((:=) posfn), + (Printf.sprintf "filename: locations file name; default to \"%s\" (file format: n lat lon)" !posfn) + ); + ] + ignore + usage; + try + let buf = Scanf.Scanning.from_file !posfn in + let _ = read_positions buf in + let doit path = + let d = path_length path in + Printf.printf "Path:"; + Array.iter (Printf.printf " %d") path; + Printf.printf ": %f\n" d; + let cooling = Anneal.kirkpatrick_seq 0.9999 10.0 in + let (n, sol, score) = Anneal.optimize path (fun p -> -. path_length p) reversed_section 5000 cooling in + Printf.printf " Optimization: %d evaluations; score=%f; sol=" n score; + Array.iter (Printf.printf "%d ") sol; + print_newline () + in + (* + let _ = doit [|1; 1;|] in (* TODO something wrong ... infinite loop ... probably in solution generation! *) + let _ = doit [|1; 2;|] in + let _ = doit [|1; 3;|] in + let _ = doit [|2; 3;|] in + let _ = doit [|3; 2;|] in + *) + let _ = doit [|1; 1; 2;|] in + let _ = doit [|1; 2; 3;|] in + () + with + exn -> + Printf.printf "ERROR:%s\n%s\n" (Printexc.to_string exn) usage; + ex/tspRun.ml test/.seqTest.ml.swp 6edd0ae35a5b357dfe597a476cd368e7a6aa57a0 Ludovic Coquelle lcoquelle@gmail.com http://github.com/khigia/ocaml-anneal/commit/88768c8f39323eb34283cba73a53f6db1407907d 88768c8f39323eb34283cba73a53f6db1407907d 2008-06-10T07:54:25-07:00 2008-06-10T07:54:25-07:00 Added some latitude/longitude-based distance metric in TSP example. e9461c1b1ee475a0739b6f97389aebc6f0b1c019 Ludovic Coquelle lcoquelle@gmail.com