Graphe.ml

Implantation des graphes en "semi-dynamique": la liste des sommets est un vecteur et par conséquent les listes d'adjacence contiennent les numéros des sommets. Attention, les tableaux OCaml commecant à 0, on numérote les sommets de 0 à (ordre - 1).

Le programme charge un fichier "graphe.ex" dont le format est le suivant:

• La première ligne contient l'ordre du graphe;
• les lignes suivantes contiennent la description de la matrice d'adjacence où les entiers sont séparés par ':'.
• Chaque ligne (sauf la première) doit se terminer par ':' suivit d'un retour à la ligne.

Le fichier suivant correspond au graphe G1 du td.

9
0:1:1:0:0:0:1:0:0:
0:0:0:1:0:0:0:0:0:
0:0:0:0:0:1:0:0:1:
0:0:0:0:0:0:1:0:0:
0:0:0:1:0:0:0:0:0:
0:0:1:0:0:0:1:0:1:
0:0:0:1:1:0:0:0:0:
0:0:0:0:0:1:1:0:1:
0:0:0:0:0:0:0:0:0:

Le reste du code est commenté et correspond au TD d'algo sur les graphes.

(* graphe.ml *)

(* Les sommets *)
type sommets = {
  mutable succ : (int * float) list;
  mutable pred : (int * float) list;
}

let sommet_vide () = { succ = []; pred = []; }

(* 1-graphe oriente value*)
type graphe = {
  ordre : int;
  sommets: sommets array;
}

(* Creation d'un graphe depuis la matrice d'adjacence *
 * et de la matrice celle de cout. Meme si la matrice *
 * d'adjancence represente un p-graphe, on ne         *
 * construit que des 1-graphes                        *)
let from_matrix ordre adj cost =
  let g = {
    ordre = ordre;
    sommets = Array.init ordre (fun _ -> sommet_vide ());
  } in
    for i = 0 to (ordre - 1) do
      for j = 0 to (ordre - 1) do
	if (adj.(i).(j) <> 0) then
	  begin
	    (* Ajout du successeur *)
	    g.sommets.(i).succ <- (j, cost.(i).(j))::g.sommets.(i).succ;
	    (* Ajout du predecesseur *)
	    g.sommets.(j).pred <- (i, cost.(i).(j))::g.sommets.(j).pred;
	  end
      done
    done;
    g

(* Parcours en largeur et construction du vecteur de pere.    *
 * Attention les tableaux commencent à 0, par consequent les  *
 * sommets sont aussi numerotes de 0 à (ordre-1). Les racines *
 * sont marquees par -1 et les sommets non visites par -42    *)
let largeur g s =
  (* initialisation du vecteur de pere *)
  let pere = Array.make g.ordre (-42) in
    (* La fonction recursive *)
  let larg_rec s =
    begin
      (* marquage du pere *)
      pere.(s) <- -1;
      (* Creation de la file *)
      let q = Queue.create () in
	Queue.add s q;
	(* boucle principale *)
	while not (Queue.is_empty q) do
	  let s = Queue.take q in
	    List.iter
	      (fun (pa,_) ->
		 if pere.(pa) = -42 then
		   begin
		     pere.(pa) <- s;
		     Queue.add pa q;
		   end
	      ) g.sommets.(s).succ
	done
    end
  in
    begin
      larg_rec s;
      for i = 0 to (g.ordre - 1) do
	if pere.(i) = -42 then
	  larg_rec i
      done;
      pere
    end

let make_matrix_from_stream s =
  (* recupere la premiere ligne qui doit coder un entier *)
  let rec get_ordre s =
    let c = Stream.next s in
      if (c = '\n') then ""
      else (String.make 1 c)^(get_ordre s)
  in
  let rec get_num s =
    let c = Stream.next s in
      if (c = ':') then ""
      else (String.make 1 c)^(get_num s)
  in
  let ordre = int_of_string (get_ordre s) in
  let adj = Array.make_matrix ordre ordre 0 in
    for i = 0 to (ordre - 1) do
      for j = 0 to (ordre -1) do
	adj.(i).(j) <- int_of_string (get_num s)
      done;
      ignore(Stream.next s)
    done;
    (ordre,adj)

(* Affiche le graphe (uniquement les successeurs) *)
let print_graphe g =
  let rec print_ladj = function
      [] -> Printf.printf "X"
    | (nb,c)::t ->
	Printf.printf "%i -> " nb;
	print_ladj t
  in
    Array.iteri
      (fun s adj ->
	 Printf.printf "%i : " s;
	 print_ladj adj.succ;
	 Printf.printf "\n";
      ) g.sommets

let main () =
  let s = Stream.of_channel (open_in "graphe.ex") in
  let (ordre,adj) = make_matrix_from_stream s in
  let g = from_matrix ordre adj (Array.make_matrix ordre ordre 0.) in
  let pere = largeur g 7 in
    print_graphe g;
    Printf.printf "\n";
    Array.iteri (fun s p -> Printf.printf "%i <- %i\n" s p) pere;
    exit 0

let _ = main ()