Recherche de chemins de moindre coût

Recherche de chemins de moindre coût

La recherche de chemin de moindre coût dans un graphe orienté est utilisée dans de nombreuses applications. On s'intéresse ici à la détermination d'un itinéraire de voyage. Pour cela on représente les différentes étapes et routes par un graphe orienté, valué par le coût entre deux étapes. On utilise l'algorithme de Dijkstra pour la détermination du chemin de moindre coût entre deux étapes. Cette application va être l'occasion d'utiliser les bibliothèques présentées précédemment. On peut citer dans l'ordre d'apparition, les modules Genlex et Printf pour les entrées-sorties, le module Weak pour implanter un cache, le module Sys pour compter le temps gagné par le cache et la bibliothèque Upi pour construire l'interface graphique. On réutilise le module Sys à la construction d'une application autonome en récupérant le nom du fichier de description du graphe comme argument de la ligne de commande.

Représentation des graphes

Un graphe orienté valué est défini par son ensemble de sommets, son ensemble d'arcs et l'ensemble des valeurs associées à chaque arc. Il existe de nombreuses implantations du type de données graphe orienté valué.

les matrices d'adjacence :
où chaque case de la matrice (m(i,j)) représente un arc entre les sommets i et j, son contenu est la valeur associée à l'arc ;
les listes d'adjacence :
où chaque sommet i est lié à une liste [j₁; ..; j_n] de sommets et chaque couple (i, j_k) est un arc du graphe ;
un triplet :
liste de sommets, liste des d'arcs et fonction de calcul des valeurs des arcs.

La pertinence de ces représentations varie selon la taille du graphe et le nombre d'arcs. Comme le propos de cette application est en partie de montrer comment mémoriser certains calculs déjà effectués sans remplir la mémoire, on utilise une matrice d'adjacence pour les graphes orientés valués. Ainsi l'occupation mémoire ne sera pas perturbée par la manipulation de listes.


# type  cout  = Nan | Cout of float;;
# type  mat_adj =  cout array array;;
# type 'a graphe = { mutable ind : int; 
                    taille : int; 
                    sommets : 'a array;  
                    m :  mat_adj};;

Le champ taille contient le nombre maximal de sommets et le champs ind, le nombre courant de sommets.

On définit ensuite quelques fonctions permettant de créer pas à pas un arc.

La fonction de création d'un graphe prend en arguments un sommet et le nombre maximal de sommets.


# let cree_graphe s t = 
   { ind = 0; taille = t; sommets = Array.create t s; 
     m = Array.create_matrix t t Nan } ;;
val cree_graphe : 'a -> int -> 'a graphe = <fun>

La fonction appartient vérifie si un sommet n est dans le graphe g.


# let appartient s g = 
   let rec aux i =
     (i < g.taille) & ((g.sommets.(i) = s) or (aux (i+1)))
   in aux 0;;
val appartient : 'a -> 'a graphe -> bool = <fun>

La fonction index retourne l'indice d'un sommet s dans un graphe g. Si ce sommet n'existe pas alors l'exception Not_found est déclenchée.


# let index s g = 
   let rec aux i = 
     if i >= g.taille then raise Not_found
     else if g.sommets.(i) = s then i 
          else aux (i+1)
   in aux 0 ;;
val index : 'a -> 'a graphe -> int = <fun>

Les deux fonctions suivantes ajoutent respectivement un sommet et un arc entre deux sommets de coût c à un graphe.


# let ajoute_sommet s g = 
   if g.ind = g.taille then failwith "le graphe est plein"
   else if appartient s g then failwith "le sommet existe déjà"
   else (g.sommets.(g.ind) <- s; g.ind <- g.ind + 1) ;;
val ajoute_sommet : 'a -> 'a graphe -> unit = <fun>
# let ajoute_arc s1 s2 c g = 
   try
     let x = index s1 g and y = index s2 g in 
       g.m.(x).(y) <- Cout c 
   with Not_found -> failwith "sommet inexistant" ;;
val ajoute_arc : 'a -> 'a -> float -> 'a graphe -> unit = <fun>

On peut alors facilement créer un graphe orienté valué complet à partir d'une liste de sommets et d'arcs. La fonction test_aho construit le graphe de la figure 13.8 :


# let test_aho () = 
   let g = cree_graphe "rien" 5 in 
     List.iter (fun x -> ajoute_sommet x g) ["A"; "B"; "C"; "D"; "E"];
     List.iter (fun (a,b,c) -> ajoute_arc a b c g) 
       ["A","B",10.;
        "A","D",30.;
        "A","E",100.0;
        "B","C",50.;
        "C","E",10.;
        "D","C",20.;
        "D","E",60.];
     for i=0 to g.ind -1 do g.m.(i).(i) <- Cout 0.0 done;
      g;;
val test_aho : unit -> string graphe = <fun>
# let a = test_aho();;
val a : string graphe =
  {ind=5; taille=5; sommets=[|"A"; "B"; "C"; "D"; "E"|];
   m=[|[|Cout 0; Cout 10; Nan; Cout 30; Cout ...|]; ...|]}

Figure 13.8 : Graphe de test

Construction de graphes

Il peut être assez fastidieux de devoir construire les graphes directement dans un programme. Pour éviter cela, nous définissons un format pour représenter les graphes sous une forme textuelle. On peut alors lire, à partir d'un fichier texte, les informations d'un graphe et le construire.

Un fichier de description d'un graphe contient une suite de lignes. Chaque ligne suit un des formats suivants :

le nombre de noeuds : TAILLE nombre
le nom d'un sommet : SOMMET nom
le coût d'un arc : ARC nom1 nom2 cout
des commentaires : # phrase

Par exemple, le fichier aho.dat suivant décrit le graphe de la figure 13.8 :

TAILLE 5
SOMMET A
SOMMET B
SOMMET C
SOMMET D
SOMMET E
ARC A B 10.0
ARC A D 30.0
ARC A E 100.0
ARC B C 50.
ARC C E 10.
ARC D C 20.
ARC D E 60.

Pour analyser de tels fichiers, on utilise le module Genlex d'analyse lexicale. L'analyseur lexicale est construit à partir de la liste de mots clés keywords.

La fonction parser_line effectue les actions associées aux mots clés en modifiant une référence sur un graphe.


# let keywords = [ "TAILLE"; "SOMMET"; "ARC"; "#"];;
val keywords : string list = ["TAILLE"; "SOMMET"; "ARC"; "#"]
# let lexer_line l = Genlex.make_lexer keywords (Stream.of_string l);;
val lexer_line : string -> Genlex.token Stream.t = <fun>
# let parser_line g s = match  s with parser
   [< '(Genlex.Kwd  "TAILLE"); '(Genlex.Int n) >] -> 
       g := cree_graphe "" n
 | [< '(Genlex.Kwd  "SOMMET"); '(Genlex.Ident nom) >] -> 
       ajoute_sommet nom !g
 | [< '(Genlex.Kwd  "ARC"); '(Genlex.Ident n1); 
      '(Genlex.Ident  n2); '(Genlex.Float c) >] -> 
       ajoute_arc n1 n2 c !g
 | [< '(Genlex.Kwd  "#") >] -> ()
 | [<>] -> () ;;
val parser_line : string graphe ref -> Genlex.token Stream.t -> unit = <fun>

On utilise cet analyseur pour définir la fonction de création d'un graphe utilise à partir des données d'un fichier :


# let create_graphe name = 
   let g = ref {ind=0; taille=0; sommets =[||]; m = [||]} in 
   let ic = open_in name in 
    try 
      print_string ("Loading "^name^": ");
      while true do 
       print_string "."; 
        let l = input_line ic in parser_line g (lexer_line l)  
      done;
      !g
    with End_of_file -> print_newline(); close_in ic; !g ;;
val create_graphe : string -> string graphe = <fun>

L'appel suivant construit un graphe à partir du fichier aho.dat.


# let b = create_graphe "PROGRAMMES/aho.dat" ;;
Loading PROGRAMMES/aho.dat: ..............
val b : string graphe =
  {ind=5; taille=5; sommets=[|"A"; "B"; "C"; "D"; "E"|];
   m=[|[|Nan; Cout 10; Nan; Cout 30; Cout 100|]; ...|]}

Algorithme de Dijkstra

L'algorithme de Dijkstra permet de trouver le chemin de coût minimal entre deux sommets. Le coût d'un chemin entre un sommet s1 et un sommet s2 est la somme des coûts des arcs de ce chemin. Un coût est toujours positif, c'est-à-dire que l'on ne gagne pas de repasser par un sommet. C'est une condition de correction de l'algorithme.

L'algorithme de Dijkstra calcule en fait tous les chemins de moindre coût d'une source S1 vers l'ensemble sommets atteignables depuis cette source. L'idée est de supposer connus les chemins de moindre coût de S1 vers un ensemble de sommets et d'étendre cet ensemble en considérant les sommets accessibles par un arc à partir de l'un des sommets déjà connu en retenant ceux qui augmentent le moins le coût des chemins.

Pour conserver l'état de la recherche, on définit le type etat_recherche puis une fonction de création de l'état initial :


# type etat_recherche = { chemins : int array;
                         deja_traites : bool array;
                         distances : cout array;
                         source :int; 
                         nb : int};;
# let creer_etat () =  { chemins = [||]; deja_traites = [||]; distances = [||]; 
                        nb = 0; source = 0};;

Le champ source contient le sommet de départ ; le champ deja_traites, les sommets dont on connaît déjà le chemin optimal à partir de la source et le champ nb, le nombre de sommets déjà traités. Le vecteur distances tient à jour les distances minimales entre la source et les autres sommets. Le vecteur chemin contient, pour chaque sommet, le sommet le précédent dans le chemin de moindre coût. On peut ainsi reconstituer un chemin de la source vers n'importe quel autre sommet.

Fonctions sur les coûts

On définit tout d'abord quatre fonctions utilitaires sur les coûts : a_cout pour tester de l'existence d'un arc, float_of_cout pour la conversion en flottant, add_cout pour l'addition de deux coûts et inf_cout vérifiant si un coût est inférieur à un autre.

# let a_cout c = match c with Nan -> false | _-> true;;
val a_cout : cout -> bool = <fun>
# let float_of_cout c = match c with 
   Nan -> failwith "float_of_cout"
 | Cout x -> x;;
val float_of_cout : cout -> float = <fun>
# let add_cout  c1 c2 = match (c1,c2) with 
   Cout x, Cout y -> Cout (x+.y)
 | Nan, Cout y -> c2
 | Cout x, Nan -> c1 
 | Nan, Nan ->  c1;;
val add_cout : cout -> cout -> cout = <fun>
# let inf_cout  c1 c2 = match (c1,c2) with 
   Cout x, Cout y -> x < y
 | Cout x, Nan -> true
 | _, _ ->  false;;
val inf_cout : cout -> cout -> bool = <fun>

La valeur Nan joue un rôle particulier dans les calculs et la comparaison. Nous y reviendrons lorsque nous aurons donné la fonction principale (voir page ??).

Implantation de l'algorithme

La recherche d'un sommet servant à étendre les chemins déjà calculés est divisée en deux fonctions : premier_non_traite qui sélectionne un premier sommet non encore visité ; celui-ci sert de valeur initiale pour la fonction pp_non_traite qui retourne le sommet non encore traité dont l'ajout à l'ensemble des chemin construit est minimal.


# exception Trouve of int;;
exception Trouve of int
# let premier_non_traite er = 
   try 
     for i=0 to er.nb-1 do 
       if not er.deja_traites.(i) then raise (Trouve i)
     done;
     raise Not_found;
     0
   with Trouve i -> i ;;
val premier_non_traite : etat_recherche -> int = <fun>
# let pp_non_traite p er =
   let si = ref p  
   and sd = ref er.distances.(p) in 
     for i=p+1 to er.nb-1 do 
       if not er.deja_traites.(i) then 
        if inf_cout er.distances.(i)  !sd then 
          ( sd := er.distances.(i);
            si := i )
     done;
     !si,!sd;;
val pp_non_traite : int -> etat_recherche -> int * cout = <fun>

La fonction une_etape sélectionne un nouveau sommet, l'ajoute à l'ensemble des sommets traités et met à jour les chemins et distances des autres sommets non traités s'il y a lieu.


# exception No_way;;
exception No_way
# let une_etape er  g = 
   let p = premier_non_traite er  in 
   let np,nc = pp_non_traite p er in
     if not(a_cout nc  ) then raise No_way 
     else 
     begin
       er.deja_traites.(np) <- true;
       for i = 0 to er.nb -1 do
         if not er.deja_traites.(i) then 
         if a_cout g.m.(np).(i) then
           let ic = add_cout er.distances.(np)  g.m.(np).(i) in 
             if inf_cout ic er.distances.(i)   then (
               er.chemins.(i) <- np;
               er.distances.(i) <- ic
              ) 
       done;
       er
     end;;
val une_etape : etat_recherche -> 'a graphe -> etat_recherche = <fun>

Il ne reste plus qu'à itérer la fonction précédente pour implanter l'algorithme de Dijkstra. La fonction dij prend un sommet et un graphe puis retourne une valeur de type etat_recherche contenant les informations pour déduire le chemin de moindre coût de cette source vers n'importe quel sommet atteignable à partir de celle-ci.


# let dij s g = 
   if appartient s g then 
   begin
     let i = index s g in 
     let er = { chemins = Array.create g.ind (-1) ;
                deja_traites = Array.create g.ind false;
                distances = Array.create g.ind Nan;
                nb = g.ind;
                source = i}  in
       er.deja_traites.(i) <- true; 
       for j=0 to g.ind-1 do 
         let c = g.m.(i).(j) in 
           er.distances.(j) <- c;
           if a_cout c then er.chemins.(j) <- i 
       done;
       try
         for k = 0 to er.nb-2 do 
           ignore(une_etape er g) 
         done;
         er
       with No_way -> er
   end
   else failwith "dij: sommet inconnu";;
val dij : 'a -> 'a graphe -> etat_recherche = <fun>

La valeur Nan est donnée comme valeur initiale des distances. Elle représente une distance infinie, ce qui est cohérent avec la fonction de comparaison inf_cout. En revanche. Pour l'addition des coûts (fonction add_cout, cette valeur est considérée comme nulle. Ce qui permet une mise à jour simple du tableau des distances.

On peut dont maintenant tester la recherche selon l'algorithme de Dijkstra.


# let a = test_aho ();;
# let r = dij "A" a;;

Les résultats bruts sont les suivants :


# r.chemins;;
- : int array = [|0; 0; 3; 0; 2|]
# r.distances;;
- : cout array = [|Cout 0; Cout 10; Cout 50; Cout 30; Cout 60|]

Pour rendre ces résultats plus lisibles, nous définissons ci-dessous une fonction d'affichage.

Affichage de la solution

En utilisant le tableau chemins de la valeur calculée par la fonction dij, on n'a que le dernier arc des chemins calculés. Il faut donc, pour afficher la totalité de ces chemins, remonter récursivement jusqu'à la source.


# let aff_etat f (g,et)  dest = 
   if appartient dest g then 
      let d = index dest g in
        let rec aux is = 
           if is = et.source then Printf.printf "%a"  f g.sommets.(is)
           else (
             let old = et.chemins.(is) in 
             aux old;
             Printf.printf " -> (%4.1f) %a" (float_of_cout g.m.(old).(is))
                                          f g.sommets.(is)  
           )
        in 
          if not(a_cout et.distances.(d)) then Printf.printf "no way\n"
          else (
            aux d;
            Printf.printf " = %4.1f\n" (float_of_cout et.distances.(d)));;
val aff_etat :
  (out_channel -> 'a -> unit) -> 'a graphe * etat_recherche -> 'a -> unit =
  <fun>

Cette fonction récursive utilise la pile d'appel pour afficher dans le bon ordre les sommets. On note l'utilisation d'un format "a" pour conserver le polymorphisme des graphes y compris pour l'affichage, d'où le paramètre fonctionnel f.

Le chemin optimal entre le sommet "A" (indice 0) et "E" (indice 4) est affiché ainsi :


# aff_etat (fun x y -> Printf.printf "%s!" y) (a,r) "E";;
A! -> (30.0) D! -> (20.0) C! -> (10.0) E! = 60.0
- : unit = ()

On indique les différentes sommets du chemin ainsi que les coûts de chaque étape.

Utilisation d'un cache

L'algorithme de Dijkstra calcule tous les chemins de moindre coût issus d'une source. On aimerait donc conserver ces valeurs en vue d'une prochaine recherche à partir de la même source. Cette mémorisation de résultats risque néanmoins d'occuper une part importante de la mémoire. D'où l'idée d'utiliser les << pointeurs faibles >>. Si on conserve les résultats des recherches à partir d'une source dans un tableau de pointeurs faibles, il devient ensuite possible, pour une nouvelle recherche, de vérifier si le calcul a déjà été effectué. Comme ce sont des pointeurs faibles, l'espace mémoire de ces états peut être libéré en cas de besoin par le GC. Cela permet de ne pas perturber le reste du programme par une occupation mémoire trop importante. Au pire des cas le calcul peut être refait s'il y a une demande.

Implantation du cache

On définit un nouveau type 'a recherche_graphe :


# type 'a recherche_graphe =  
   { g : 'a graphe; w : etat_recherche Weak.t } ;;

Les champs g et w correspondent au graphe et au tableau de pointeurs faibles sur les états de recherche pour chaque source possible.

On construit de telles valeurs par la fonction create_recherche.


# let create_rech_graphe g = 
   { g = g;
     w = Weak.create g.ind } ;;
val create_rech_graphe : 'a graphe -> 'a recherche_graphe = <fun>

La fonction dij_rapide vérifie si la recherche a déjà été calculée, si oui, elle retourne le résultat mémorisé, sinon, elle effectue le calcul et l'enregistre dans le tableau de pointeurs faibles.


# let dij_rapide s rg = 
   let i = index s rg.g in 
     match Weak.get rg.w i with 
       None -> let er = dij s rg.g in 
                 Weak.set rg.w i (Some er);
                 er
     | Some er -> er;;
val dij_rapide : 'a -> 'a recherche_graphe -> etat_recherche = <fun>

La fonction d'affichage reste utilisable :


# let rg_a = create_rech_graphe a in
 let r = dij_rapide "A" rg_a in
  aff_etat (fun x y -> Printf.printf "%s!" y) (a,r) "E" ;;
A! -> (30.0) D! -> (20.0) C! -> (10.0) E! = 60.0
- : unit = ()

Évaluation des performances

Nous allons tester les performances des fonctions dij et dij_rapide en itérant chacune d'elle sur une liste de source tirée au hasard. On simule ainsi une application dans laquelle il faudrait calculer souvent un chemin entre deux points d'un graphe (un itinéraire ferroviaire, par exemple).

Pour obtenir les temps de calcul, nous définissons la fonction suivante :


# let exe_time f g ss =
   let t0 = Sys.time() in
    Printf.printf "Début (%5.2f)\n" t0;
    List.iter (fun s -> ignore(f s g)) ss;
    let t1 = Sys.time() in
     Printf.printf "Fin (%5.2f)\n" t1;
     Printf.printf "Durée = (%5.2f)\n" (t1 -. t0) ;;
val exe_time : ('a -> 'b -> 'c) -> 'b -> 'a list -> unit = <fun>

On tire donc au hasard une liste de 20000 sommets et on mesure les performances contenues sur le graphe a :


# let ss = 
  let ss0 = ref [] in
  let i0 = int_of_char 'A' in
  let new_s i = Char.escaped (char_of_int (i0+i)) in
  for i=0 to 20000 do ss0 := (new_s (Random.int a.taille))::!ss0 done;
  !ss0 ;;
val ss : string list =
  ["A"; "B"; "D"; "A"; "E"; "C"; "B"; "B"; "D"; "E"; "B"; "E"; "C"; "E"; "E";
   "D"; "D"; "A"; "E"; ...]
# Printf.printf"Fonction dij :\n";
 exe_time dij a ss ;;
Fonction dij :
Début ( 7.08)
Fin ( 8.02)
Durée = ( 0.94)
- : unit = ()
# Printf.printf"Fonction dij_rapide :\n";
 exe_time dij_rapide (create_rech_graphe a) ss ;;
Fonction dij_rapide :
Début ( 8.02)
Fin ( 8.13)
Durée = ( 0.11)
- : unit = ()

Les résultats obtenus sont cohérents. Il est clair que l'accès direct au résultat contenu dans le cache est bien plus rapide que la reconstruction du résultat.

Interface graphique

On se propose de construire l'interface graphique de visualisation des graphes en utilisant la bibliothèque Upi. Cette interface permet de sélectionner les sommets origine et destination du chemin à rechercher. Une fois le chemin de moindre coût trouvé, celui-ci s'affiche graphiquement. On définit le type 'a gg qui regroupe les champs de description de graphe et de la recherche, ainsi que les champs de l'interface graphique.


#  #load "PROGRAMMES/upi.cmo";;


# type 'a gg = { mutable src : 'a * Upi.component; 
                mutable dest : 'a * Upi.component;
                pos : (int * int) array;
                rg : 'a recherche_graphe;
                mutable etat : etat_recherche;
                mutable main : Upi.component;
                to_string : 'a -> string;
                from_string : string -> 'a } ;;

Les champs src et dest sont des couples (sommet,composant) liant un sommet à un composant. Le champ pos contient les positions de chaque composant. Le champ main est le conteneur principal de l'ensemble des composants. Les deux fonctions to_string et from_string sont les fonctions de conversion du type 'a avec les chaînes. Les éléments nécessaires pour la construction de telles valeurs sont les informations du graphe, le tableau de positions et les fonctions de conversion.

# let cree_gg rg vpos ts fs = 
   {src = rg.g.sommets.(0),Upi.empty_component;
    dest = rg.g.sommets.(0),Upi.empty_component;
    pos = vpos;
    rg = rg;
    etat = creer_etat () ;
    main = Upi.empty_component;
    to_string = ts;
    from_string = fs};;
val cree_gg :
  'a recherche_graphe ->
  (int * int) array -> ('a -> string) -> (string -> 'a) -> 'a gg = <fun>

Visualisation

Le dessin du graphe nécessite de dessiner les sommets et de tracer les arcs. Les sommets sont représentés par des composants boutons de la bibliothèque Upi. Par contre les arcs sont directement tracés dans la fenêtre principale. La fonction display_arc affiche les différents arcs. La fonction display_shortest_path affiche dans une autre couleur le chemin trouvé.

Tracé des arcs

Un arc relie deux sommets et possède une valeur associée. Le lien entre deux sommets peut être représenté par un tracé de ligne. La difficulté principale provient de l'affichage du sens de cette ligne. On choisit de le représenter par une flèche. Pour être bien orientée, celle-ci doit subir une rotation de l'angle que fait la ligne avec l'axe des abscisses. Enfin les coûts doivent être affichés à côté de l'arc.

Pour le tracé d'une flèche d'un arc, on définit : les fonctions rotate et translate qui effectuent respectivement une rotation et une translation ; la fonction display_arrow dessine la flèche dont l'extrémité est en fait un triangle.


# let rotate l a = 
   let ca = cos a  and sa = sin a in 
     List.map (function (x,y) -> ( x*.ca +. -.y*.sa, x*.sa +. y*.ca)) l;;
val rotate : (float * float) list -> float -> (float * float) list = <fun>
# let translate l (tx,ty) = 
   List.map (function (x,y) -> (x +. tx, y +. ty)) l;;
val translate :
  (float * float) list -> float * float -> (float * float) list = <fun>
# let display_arrow (mx,my) a = 
   let triangle = [(5.,0.); (-3.,3.); (1.,0.); (-3.,-3.); (5.,0.)] in
   let tr =  rotate triangle a in 
   let ttr = translate tr (mx,my) in 
   let tt = List.map (function (x,y) -> (int_of_float x, int_of_float y)) ttr 
   in
     Graphics.fill_poly (Array.of_list tt);;
val display_arrow : float * float -> float -> unit = <fun>

L'affichage du coût d'un arc positionne le point où démarre le texte en fonction de l'angle de l'arc.


# let display_label (mx,my) a lab = 
   let (sx,sy) = Graphics.text_size lab in
   let pos = [ float(-sx/2),float(-sy) ] in 
   let pr = rotate pos a in
   let pt = translate pr (mx,my) in 
     let px,py = List.hd pt in 
       let ox,oy = Graphics.current_point () in 
         Graphics.moveto ((int_of_float mx)-sx-6) 
                          ((int_of_float my) );
         Graphics.draw_string lab;
         Graphics.moveto ox oy;;
val display_label : float * float -> float -> string -> unit = <fun>

L'affichage d'un arc reprend les fonctions précédentes. Ses paramètres sont le graphe interfacé gg, les sommets i et j, et la couleur du tracé (col).


# let display_arc gg col i j = 
   let g = gg.rg.g in  
   let x,y = gg.main.Upi.x,gg.main.Upi.y in 
     if a_cout g.m.(i).(j) then (
       let (a1,b1) = gg.pos.(i)
       and (a2,b2) = gg.pos.(j) in 
         let x0,y0 = x+a1,y+b1         and x1,y1 = x+a2,y+b2 in
         let rxm =  (float(x1-x0)) /. 2.  and rym =  (float(y1-y0)) /. 2. in
         let xm = (float x0) +. rxm and ym = (float y0) +. rym in
           Graphics.set_color col;
           Graphics.moveto x0 y0;
           Graphics.lineto x1 y1;
           let a =  atan2 rym rxm in 
           display_arrow (xm,ym) a;
           display_label (xm,ym) a 
             (string_of_float(float_of_cout g.m.(i).(j))));;
val display_arc : 'a gg -> Graphics.color -> int -> int -> unit = <fun>

Affichage d'un chemin

L'affichage d'un chemin applique le tracé des différents arcs par lesquels passe le chemin. Cet affichage du chemin vers une destination reprend la technique utilisée pour l'affichage texte.


# let rec display_shortest_path gg col dest = 
   let g = gg.rg.g in 
     if appartient dest g then 
       let d = index dest g in
        let rec aux is = 
           if is = gg.etat.source then ()
           else (
             let old = gg.etat.chemins.(is) in 
               display_arc gg col old is;
               aux old )
        in 
          if not(a_cout gg.etat.distances.(d)) then Printf.printf "no way\n"
          else aux d;;
val display_shortest_path : 'a gg -> Graphics.color -> 'a -> unit = <fun>

Affichage du graphe

La fonction display_gg affiche un graphe complet. Dans le cas où le sommet destination est non vide, elle trace le chemin entre l'origine et la destination.


#  let display_gg gg () =  
   Upi.display_rect gg.main ();
   for i=0 to gg.rg.g.ind -1 do 
     for j=0 to gg.rg.g.ind -1 do 
       if i<> j then display_arc gg (Graphics.black) i j 
     done
   done;
   if snd gg.dest != Upi.empty_component then 
      display_shortest_path gg Graphics.red (fst gg.dest);;
val display_gg : 'a gg -> unit -> unit = <fun>

Il reste à dessiner les sommets. Comme l'interaction avec l'utilisateur proviendra de la sélection des sommets source et destination, nous définissons un composant pour les sommets.

Composant sommet

La principale action d'un utilisateur est de choisir les extrémités du chemin à rechercher. Pour cela un sommet doit être un composant qui réagit au clic souris et posséder un état lui indiquant si l'on vient de choisir la source ou la destination. On choisit le composant bouton qui effectue une action à la suite d'un clic souris.

Action des sommets

Il est nécessaire de visualiser la sélection d'un sommet. Pour cela on inverse la couleur du fond de celui-ci par la fonction inverse.


# let inverse b = 
   let gc = Upi.get_gc b in 
     let fcol = Upi.get_gc_fcol gc 
     and bcol = Upi.get_gc_bcol gc in 
       Upi.set_gc_bcol gc fcol;
       Upi.set_gc_fcol gc bcol;;
val inverse : Upi.component -> unit = <fun>

La fonction action_b effectue cette sélection. Elle est appliquée lors d'un clic souris sur un sommet. Elle prend comme paramètres le sommet associé au bouton ainsi que le graphe pour pouvoir modifier la source ou la destination de la recherche. Quand ces deux sommets sont déterminés, alors elle applique la fonction dij_rapide pour trouver le chemin de moindre coût.

            
# let action_clic som gg b bs = 
   let (s1,s) = gg.src
   and (s2,d) = gg.dest in 
    if  s == Upi.empty_component then (
      gg.src  <- (som,b); inverse b )
    else 
     if d == Upi.empty_component then ( 
       inverse b;
       gg.dest <- (som,b); 
       gg.etat <- dij_rapide s1 gg.rg;
      display_shortest_path gg (Graphics.red) som
     ) 
     else (inverse s; inverse d;
           gg.dest <- (s2,Upi.empty_component);
           gg.src <- som,b; inverse b);;
val action_clic : 'a -> 'a gg -> Upi.component -> 'b -> unit = <fun>

Création de l'interface

La fonction principale de création de l'interface prend un graphe interfacé et une liste d'options et crée les différents composants puis les associe au graphe. Les paramètres sont le graphe (gg), ses dimensions (gw et gh), la liste d'options du graphes et des sommets (lopt) et la liste d'options pour les bords des sommets (lopt2).

  
# let maj_gg gg gw gh lopt lopt2 = 
   let gc = Upi.make_default_context () in 
     Upi.set_gc gc lopt; 
 (* calcul de la taille max des boutons *)
     let vs = Array.map gg.to_string gg.rg.g.sommets in 
     let vsize = Array.map Graphics.text_size  vs in 
       let w = Array.fold_right (fun (x,y) -> max x)  vsize 0 
       and h = Array.fold_right (fun (x,y) -> max y)  vsize 0 in   
 (* création de main *)   
       gg.main <- Upi.create_panel true gw gh lopt;
       gg.main.Upi.display <- display_gg gg;
 (*  et création des boutons *)
         let vb_bs = 
           Array.map (fun x -> x,Upi.create_button (" "^(gg.to_string x)^" ") 
                        lopt)
                      gg.rg.g.sommets in 
           let f_act_b = Array.map (fun (x,(b,bs)) -> 
                                    let ac = action_clic x  gg b
                                    in Upi.set_bs_action bs ac)  vb_bs in
           let bb = 
             Array.map (function (_,(b,_)) -> Upi.create_border b lopt2) vb_bs 
           in 
             Array.iteri 
               (fun i (b) -> let x,y = gg.pos.(i) in 
                               Upi.add_component gg.main  b 
                                 ["PosX",Upi.Iopt (x-w/2); 
                                  "PosY", Upi.Iopt (y-h/2)]) bb;
           ();;
val maj_gg :
  'a gg ->
  int ->
  int -> (string * Upi.opt_val) list -> (string * Upi.opt_val) list -> unit =
  <fun>

Les boutons sont créés automatiquement et sont bien ajoutés à la fenêtre principale.

Test de l'interface

Tout est prêt alors pour la création d'une interface. On utilise un graphe dont les sommets sont des chaînes de caractères pour simplifier les fonctions de conversion. On construit le graphe gg de la manière suivante :


# let id x = x;;
# let pos =  [| 200, 300; 80, 200 ; 100, 100; 200, 100;  260, 200 |];; 
# let gg = cree_gg  (create_rech_graphe (test_aho())) pos id id;;
# maj_gg  gg 400 400 ["Background", Upi.Copt  (Graphics.rgb 130 130 130);
             "Foreground",Upi.Copt  Graphics.green] 
 [ "Relief", Upi.Sopt "Top";"Border_size", Upi.Iopt 2];;

L'appel à Upi.loop true false gg.main;; lance la boucle d'interaction de la bibliothèque Upi.

Figure 13.9 : Sélection des sommets d'une recherche

La figure 13.9 montre le chemin trouvé entre le sommet "A" et "E". Les arcs par lesquels passe le chemin changent de couleur.

Application autonome

Nous combinons les différentes étapes rencontrées pour la construction d'une application autonome, c'est-à-dire ne nécessitant pas la présence de la distribution d'Objective CAML sur la machine où elle s'exécute. Cet application prend en argument le nom du fichier de description du graphe.

Fichier de description du graphe

Ce fichier décrit d'une part les informations du graphe ainsi que les informations utiles pour l'interface graphique. Pour celles-ci nous définissons un deuxième format. De cette description graphique, on construit une valeur de type g_info suivant.


# type g_info = {spos : (int * int) array;
                mutable opt : Upi.lopt;
                mutable g_w : int;
                mutable g_h : int};;

Le format de description des informations graphiques est décrit par les quatre mots clés de la liste key2.


# let key2 = ["HAUTEUR"; "LARGEUR"; "POSITION"; "COULEUR"];;
val key2 : string list = ["HAUTEUR"; "LARGEUR"; "POSITION"; "COULEUR"]
# let lex2 l = Genlex.make_lexer key2 (Stream.of_string l);;
val lex2 : string -> Genlex.token Stream.t = <fun>

# let pars2 g gi s = match s with parser 
    [< '(Genlex.Kwd "HAUTEUR"); '(Genlex.Int i) >] -> gi.g_h <- i
 |  [< '(Genlex.Kwd "LARGEUR"); '(Genlex.Int i) >] -> gi.g_w <- i
 |  [< '(Genlex.Kwd "POSITION"); '(Genlex.Ident s);
       '(Genlex.Int i); '(Genlex.Int j) >] -> gi.spos.(index s g) <- (i,j)
 |  [< '(Genlex.Kwd "COULEUR"); '(Genlex.Ident s);
       '(Genlex.Int r); '(Genlex.Int g); '(Genlex.Int b) >] ->
            gi.opt <- (s, Upi.Copt (Graphics.rgb r g b))::gi.opt
 | [<>] -> ();;
val pars2 : string graphe -> g_info -> Genlex.token Stream.t -> unit = <fun>

Création de l'application

La fonction create_graphe prend en entrée un nom de fichier et retourne un couple composé d'un graphe et des informations graphiques associées.


# let create_gg_graphe name = 
   let g = create_graphe name in 
     let gi = {spos = Array.create g.taille (0,0); opt=[]; g_w =0; g_h = 0;} in
   let ic = open_in name in 
   try 
     print_string ("Loading (pass 2) " ^name ^" : ");
     while true do 
       print_string ".";
       let l = input_line ic in pars2 g gi (lex2 l)
     done ;
     g,gi
   with End_of_file -> print_newline(); close_in ic; g,gi;;
val create_gg_graphe : string -> string graphe * g_info = <fun>

La fonction create_app construit l'interface d'un graphe.


# let create_app name = 
   let g,gi = create_gg_graphe name in
   let size = (string_of_int gi.g_w) ^ "x" ^ (string_of_int gi.g_h) in 
   Graphics.open_graph (":0 "^size);
   let gg = cree_gg (create_rech_graphe g) gi.spos id id in
   maj_gg gg gi.g_w gi.g_h
     [ "Background", Upi.Copt (Graphics.rgb 130 130 130) ;
       "Foreground", Upi.Copt Graphics.green ]
     [ "Relief", Upi.Sopt "Top" ; "Border_size", Upi.Iopt 2 ] ;
   gg;;
val create_app : string -> string gg = <fun>

Enfin la fonction main récupère le nom du fichier sur la ligne de commande, construit le graphe et son interface, puis lance la boucle d'interaction sur le composant principal de l'interface du graphe.


# let main () = 
   if (Array.length Sys.argv ) <> 2 
   then Printf.printf "Usage: dij.exe filename\n"
   else 
     let gg = create_app Sys.argv.(1) in 
       Upi.loop true false gg.main;;
val main : unit -> unit = <fun>

La dernière expression de ce programme lance la fonction main.

Exécutable autonome

L'intérêt de fabriquer un exécutable autonome est de faciliter sa diffusion. On regroupe l'ensemble des types et fonctions décrits dans cette section dans le fichier dij.ml. On compile ensuite ce fichier en lui joignant les différentes bibliothèques dont il se sert. Voici la ligne de compilation pour un système Linux :

ocamlc -custom -o dij.exe graphics.cma upi.cmo graphes.ml \
    -cclib -lgraphics -cclib -L/usr/X11/lib -cclib -lX11

La description de la compilation d'un exécutable autonome utilisant la bibliothèque Graphics est donnée aux chapitres 5 et 7.

Pour en faire plus

Le squelette de cette application est suffisamment généraliste pour pouvoir être réemployé dans un autre cadre que la recherche d'un itinéraire de voyage. En effet différents types de problèmes peuvent se représenter sous forme d'un graphe valué. Par exemple la recherche d'un chemin dans un labyrinthe peut se coder sous forme d'un graphe où chaque carrefour est un sommet du graphe. Trouver une solution revient à déterminer le plus court chemin entre le départ et l'arrivée.

Pour comparer les performances entre C et Objective CAML, on écrit l'algorithme de Dijkstra en C. Le programme C utilisera les structures de données Objective CAML pour effectuer le calcul.

Pour améliorer l'interface graphique, on ajoute un textfield pour le nom de fichier et deux boutons pour le chargement ou la sauvegarde d'un graphe. L'utilisateur peut aussi modifier les emplacements des sommets à la souris pour améliorer le rendu.

Une deuxième amélioration de l'interface graphique est de pouvoir choisir la forme des sommets. L'affichage d'un bouton appelle la fonction de tracé d'un rectangle. Rien n'empêche de spécialiser les fonctions d'affichage et d'appartenance par des polygones de description du sommet.