Implementation graphique 2d du voyageur de commerce par trois methodes (naive, algo optimise, puis heuristique genetique)

Commenter

Contenu du snippet 

(* 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 ();

Compatibilité : Caml, CamlLight, ObjectiveCaml

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (coucou747)