Chapitre 5

let m =
 [| [| 1.0; 0.0; 0.0 |];
    [| 0.0; 1.0; 0.0 |];
    [| 0.0; 0.0; 1.0 |] |];;

(* La matrice d'adjacence du graphe
   donné dans l'exemple.
   Attention les sommets sont numérotés
   à partir de 0 *)
let g =
 [| [| 0; 1; 1; 0; 0; 0 |];
    [| 0; 0; 1; 1; 0; 1 |];
    [| 0; 0; 0; 0; 0; 1 |];
    [| 0; 0; 0; 0; 1; 0 |];
    [| 0; 1; 0; 0; 0; 0 |];
    [| 0; 0; 0; 1; 0; 0 |] |];;

let lignes m = vect_length m
and colonnes m =
 if vect_length m = 0 then failwith "colonnes"
 else vect_length m.(0);;

(* Calcule le produit des matrices m1 et m2 *)
let multiplier m1 m2 =
 if colonnes m1 <> lignes m2
 then failwith "multiplier" else
 let résultat =
  make_matrix (lignes m1) (colonnes m2) 0 in
 for i = 0 to lignes m1 - 1 do
  for j = 0 to colonnes m2 - 1 do
   let aij = ref 0 in
   for k = 0 to colonnes m1 - 1 do
     aij := m1.(i).(k) * m2.(k).(j) + !aij;
   done;
   résultat.(i).(j) <- !aij
  done
 done;
 résultat;;

(* Calcule la somme des matrices m1 et m2 *)
let ajouter m1 m2 =
 if colonnes m1 <> lignes m2
 then failwith "ajouter" else
 let résultat =
  make_matrix (lignes m1) (colonnes m2) 0 in
 for i = 0 to lignes m1 - 1 do
  for j = 0 to colonnes m2 - 1 do
   résultat.(i).(j) <- m1.(i).(j) + m2.(i).(j)
  done
 done;
 résultat;;

(* Élève la matrice m à la puissance i *)
let rec puissance m i =
 match i with
 | 0 -> failwith "puissance"
 | 1 -> m
 | n -> multiplier m (puissance m (i - 1));;

(* On connaît le nombre de chemins
   d'ordre i en calculant puissance m i *)
let nombre_de_chemin_de_longueur_n n i j m =
 (puissance m n).(i).(j);;

(* Il y a deux chemins de longueur 2
   entre les sommets 0 et 5
  (sommets 1 et 6 de la figure 5.3) *)
#nombre_de_chemin_de_longueur_n 2 0 5 g;;
- : int = 2

(* Calcule la somme des puissances n-ième
   (pour n <= i) de la matrice m:
   sigma i m donne le nombre de chemins
   de longueur inférieure à i *)
let sigma i m =
 let rec pow i mp =
 match i with
 | 1 -> mp
 | n ->
    ajouter mp
     (pow (i - 1) (multiplier m mp)) in
 pow i m;;

let existe_chemin i j m =
 (sigma (colonnes m) m).(i).(j) <> 0;;

#existe_chemin 2 1 g;;
- : bool = true

(* Si u est en relation avec x,
   alors on ajoute les arcs u,v 
   pour tous les v successeurs de x *)
let phi m x =
 for u = 0 to colonnes m - 1 do
  if m.(u).(x) = 1 then
   for v = 0 to colonnes m - 1 do
    if m.(x).(v) = 1 then m.(u).(v) <- 1
   done
 done;;

let fermeture_transitive m =
 (* Allocation du résultat *)
 let résultat =
  make_matrix (lignes m) (colonnes m) 0 in
 (* Recopie de m dans le résultat *)
 for i = 0 to lignes m - 1 do
  for j = 0 to colonnes m - 1 do
   résultat.(i).(j) <- m.(i).(j)
  done
 done;
 (* Pour tous les sommets on applique phi *)
 for x = 0 to colonnes m - 1 do
  phi résultat x done;
 résultat;;

(* On accède transitivement à tous les sommets,
   sauf au sommet 0 *)
#fermeture_transitive g;;
- : int vect vect =
[|[|0; 1; 1; 1; 1; 1|]; [|0; 1; 1; 1; 1; 1|];
  [|0; 1; 1; 1; 1; 1|]; [|0; 1; 1; 1; 1; 1|];
  [|0; 1; 1; 1; 1; 1|]; [|0; 1; 1; 1; 1; 1|]|]

(* Listes de successeurs *)

type graphe_point == (int list) vect;;

let omega = -1;;

let transforme_mat_suc m =
 let succ =
   make_matrix (lignes m) (colonnes m) 0 in
 let k = ref 0 in
 for i = 0 to lignes m - 1 do
  k := 0;
  for j = 0 to colonnes m - 1 do
   if m.(i).(j) = 1 then begin
     succ.(i).(!k) <- j;
     incr k end
  done;
  succ.(i).(!k) <- omega
 done;
 succ;;

(* ``Listes'' de successeurs,
   {\em voir page \pageref{prog:declsucc}} *)
#transforme_mat_suc g;;
- : int vect vect =
[|[|1; 2; -1; 0; 0; 0|]; [|2; 3; 5; -1; 0; 0|];
  [|5; -1; 0; 0; 0; 0|]; [|4; -1; 0; 0; 0; 0|];
  [|1; -1; 0; 0; 0; 0|]; [|3; -1; 0; 0; 0; 0|]|]

(* Transforme une matrice d'adjacence
   en vecteur de listes de successeurs *)
let transforme_mat_list_suc m =
 let gpoint = make_vect (colonnes m) [] in
 for i = 0 to lignes m - 1 do
  for j = 0 to colonnes m - 1 do
   if m.(i).(j) = 1
   then gpoint.(i) <- j :: gpoint.(i)
  done   
 done;
 gpoint;;

#transforme_mat_list_suc g;;
- : int list vect =
 [|[2; 1]; [5; 3; 2]; [5]; [4]; [1]; [3]|]

(* succ est dorénavant un tableau de listes *)
let numéro = make_vect (vect_length succ) (-1);;
let num = ref (-1);;

let rec num_prefixe k = begin
    incr num; 
    numéro.(k) <- !num;
    do_list 
      (function  x -> if numéro.(x) = -1 then
            num_prefixe (x))
      succ.(k)
    end;;

let numPrefixe() = begin
  do_vect 
    (function x -> if numéro.(x) = -1 then
         num_prefixe (x))
    numéro
  end;;

let num_largeur k = 
    let f = file_vide() in begin
    fajouter k f;
    while not (fvide q) do
        let k = fvaleur(f) in begin
        fsupprimer f;
        incr num;
        numéro.(k) <- !num;
        do_list 
          (function  x -> if numéro.(x) = -1 then
               begin
               fajouter x f;
               numéro.(x) <-  0
               end)
          succ.(k)
        end
    done
    end;;

let numLargeur() = begin
  do_vect 
    (function x -> if numéro.(x) = -1 then
         num_largeur (x))
    numéro
  end;;

(* comp_connexe calcule la composante connexe 
   de k et retourne son point d'attache *)
let rec comp_connexe k = begin
    incr num; numéro.(k) <- !num; 
    pajouter k p;
    let min = ref !num in begin
      do_list
        (function x ->
          let m = if numéro.(x) = -1 then 
                comp_connexe (x) 
            else 
                numéro.(x)
            in if m < !min then
                min := m)
         succ.(k);
      if !min = numéro.(k) then 
        (try while true do
            printf "%d " (pvaleur(p));
            numéro.(pvaleur(p)) <- max_int;
            psupprimer(p);
            if pvaleur(p) = k then raise Exit
            done
        with Exit -> printf "\n");
      !min
      end
    end;;

let compConnexe() = begin
  do_vect 
    (function x -> if numéro.(x) = -1 then
         comp_connexe (x))
    numéro
  end;;