(* to run : $ ocaml graphics.cma vdc.ml  *)
open Graphics;;
open Complex;;
let car (a, b) = a;;
let cdr (a, b) = b;;
let dX = 1000;;
let dY = 700;;
let makeComplex x y ={re=(float_of_int x); im=(float_of_int y)};;
let z f z= f (int_of_float (z.re)) (int_of_float (z.im));;
let randomPt () = makeComplex (Random.int dX) (Random.int dY);;
let ramdom_liste n =
  let rec li acc = function | 0 -> acc | k -> li ((randomPt () )::acc) (k - 1)
  in li [] n;;
let angle z = Complex.arg
  (Complex.add z (makeComplex ( - dX / 2) ( - dY / 2)) );;
let cmp i1 i2 = if i1 > i2 then 1 else if i1 < i2 then -1 else 0;;
let pause () = let _ = read_key () in ();;
let print_newline () = print_string "\n";;
let print_complex c = print_float c.re; print_string "+ i*"; print_float c.im;;
let distance_complexe c1 c2 = Complex.norm (Complex.sub c1 c2);;
(* calcule la distance totale donnee par la liste li*)
let len_liste li =
  let distance (len, c1) c2 = (len +. (distance_complexe c1 c2), c2)
  in let d = distance
    (List.fold_left distance (0., (List.hd li)) (List.tl li))
    (List.hd li)
  in car d;;
(* dessine une ville a l'endroit c *)
let draw_ville c =
  let s = 5 in
  z moveto (Complex.add c (makeComplex s s ) );
  z lineto (Complex.add c (makeComplex s (-s) ) );
  z lineto (Complex.add c (makeComplex (-s) (-s) ) );
  z lineto (Complex.add c (makeComplex (-s) s ) );
  z lineto (Complex.add c (makeComplex s s ) );
  z moveto (Complex.add c (makeComplex 0 s ) );
  z lineto (Complex.add c (makeComplex 0 (-s) ) );
  z moveto (Complex.add c (makeComplex s 0 ) );
  z lineto (Complex.add c (makeComplex (-s) 0 ) );;
let draw_line z1 z2 = let () = z moveto z1 in let () = z lineto z2 in z2;;
let draw_liste li = draw_line (List.hd li) (List.fold_left draw_line (List.hd li) (List.tl li));;
let draw_liste li = let _ = draw_liste li in
  let distance = len_liste li in
  let _ = z moveto (makeComplex 0 0) in draw_string (string_of_float distance);;
let float_neg x = -. x;;
let (@@) f g x = f (g x);;
let max_liste f li = 
  let rec m max value f = function
  | [] -> max
  | hd::tl -> let v = f hd in if v > value
    then m hd v f tl
    else m max value f tl
  in let hd = List.hd li
  in m hd (f hd) f (List.tl li);;
let rec permutations li =
  let  a_insert  v  li  =
    let rec f li old = function
    | [] -> ( List.rev ( v::old ) )::li
    | hd ::tl -> f ( ( List.rev_append old ( v::hd::tl ) )::li ) ( hd::old) tl
  in f [] [] li
in match li with
| [] -> [[]]
| hd ::tl -> List .flatten (List .map (fun li -> a_insert hd li) (permutations tl) );;
(*
  cet algo n'est meme pas capable de calculer 10 villes
  c'est l'algo de bruteforce le plus mauvais possible en fait.
let rec main__ liste nbrvilles =
  let p = permutations liste
  in draw_liste (max_liste ( float_neg @@ len_liste ) p) ;;
*)
(* calcule facilement, en O(n*log(n)) un chemin plutot efficace *)
let on_majore liste = List.sort (fun z1 z2 -> cmp (angle z1) (angle z2) ) liste ;;
(*let rec main__ liste nbrvilles = draw_liste (on_majore liste) ;;*)
(* affiche la liste de villes *)
let rec print_liste = function
| [] -> print_newline ()
| hd::tl -> print_complex hd; print_string "\t"; print_liste tl;;
(* dessine la liste de villes *)
let step li = clear_graph ();
  (* print_liste li; *)
  set_color ( rgb 0 127 255); let _ = List.map draw_ville li in ();
  set_color ( rgb 255 127 0); draw_liste li;;
(*  pause ();; *)
(* cet algo permet d'aller BEAUCOUP plus vite. il reste deterministe *)
let best liste =
  let rec each min scoremin debut acc = function
  | [] -> 
    let score = if debut = [] then 0. else len_liste debut
    in if score >= scoremin then (min, scoremin) else
      if acc = []
    then (debut, score)
    else each min scoremin debut [] acc
  | hd::tl ->
    let (min2, scoremin2) = if tl != []
      then each min scoremin debut (hd::acc) tl
      else ( min, scoremin )
    in each min2 scoremin2 (hd::debut) (List.rev_append acc tl) []
  (* in let (out, score) = each [] 1000000. [] [] liste in out;; *)
  in let min = on_majore liste
  in let (out, score) = each min (len_liste min) [] [] liste in out;;
(* cree une nouvelle population*)
let nouvelle_population nmecs nvilles =
  let rec f acc = function
  | 0 -> acc
  | n -> f ((ramdom_liste nvilles)::acc) (n - 1)
  in f [] nmecs;;
let plus_proche c liste =
  let rec iter min minv acc = function
  | [] -> (min, acc)
  | hd::tl -> let d = distance_complexe hd c
    in if d < minv
      then iter hd d (min::acc) tl
      else iter min minv (hd::acc) tl
  in let hd = List.hd liste
  in iter hd (distance_complexe hd c) [] (List.tl liste);;
(* calcule la liste des villes selon l'adn *)
let villes adn liste =
  let rec iter vi acc li adn =
    if li = [] then vi::acc
    else let (vj, li) = plus_proche (Complex.div (Complex.add vi (List.hd adn) ) (makeComplex 2 0)) li
    in iter (vj) (vi::acc) li (List.tl adn)
  in iter (List.hd liste) [] (List.tl liste) adn;;
(* combine deux adns *)
let crossover adn1 adn2 = List.map
  (fun (a, b) -> Complex.mul ( Complex.add a b ) (makeComplex 2 0) )
  (List.combine adn1 adn2);;
(* mise a jours d'une population deja triee *)
let update_population population n nbrvilles =
  let rec f acc k pop = if k >= n then acc else match pop with
  | hd1::hd2::tl -> f (hd1::(crossover hd1 hd2)::acc) (k+2) (hd2::tl)
  | _ -> failwith "update_population"
  in f (nouvelle_population 3 nbrvilles) 3 population ;;
(* compare deux adns *)
let cmp_adn liste adn1 adn2 = cmp (len_liste (villes adn1 liste) ) (len_liste (villes adn2 liste) );;
(* tri d'une population *)
let pop_sort population liste = List.sort (cmp_adn liste) population;;
(* this statement never returns
algo genetique*)
let rec main__ liste nbrvilles =
  let nbr_commercial = 30
  in let rec adn_iter population = 
    let sorted = pop_sort population liste
    in let _ = step (villes (List.hd sorted) liste)
    in adn_iter (update_population sorted nbr_commercial nbrvilles)
  in adn_iter (nouvelle_population nbr_commercial nbrvilles);;
(* let rec main__ liste nbrvilles = step (best liste) ;; *)
(*main-like*)
let () =
  (*Random.init ( int_of_float (Sys.time ()));*)
  Random.self_init ();
  open_graph (Printf.sprintf " %ix%i" dX dY) ;
  let nbr_villes = 50
  in let liste = ramdom_liste nbr_villes
  in main__ liste nbr_villes; pause ();