Parcours de graphes

let parcours_profondeur adj depart =
  let n = Array.length adj in
  let vu = Array.make n false in
  let ordre = ref [] in
  let rec visite s =
    if not vu.(s) then begin
      vu.(s) <- true;
      ordre := s :: !ordre;
      List.iter visite adj.(s)
    end
  in
  visite depart;
  !ordre

La récursion s'enfonce dans le premier voisin non vu, puis remonte. ordre accumule les sommets dans l'ordre inverse de découverte (chaque nouveau est mis en tête).

let accessibles adj depart =
  let n = Array.length adj in
  let vu = Array.make n false in
  let rec visite s =
    if not vu.(s) then begin
      vu.(s) <- true;
      List.iter visite adj.(s)
    end
  in
  visite depart;
  vu

Le tableau vu en fin de parcours marque exactement les sommets atteignables. On a retiré l'accumulation de l'ordre : seule l'atteignabilité importe.

let parcours_largeur adj depart =
  let n = Array.length adj in
  let vu = Array.make n false in
  let f = Queue.create () in
  let ordre = ref [] in
  vu.(depart) <- true;
  Queue.push depart f;
  while not (Queue.is_empty f) do
    let s = Queue.pop f in
    ordre := s :: !ordre;
    List.iter (fun v ->
      if not vu.(v) then begin vu.(v) <- true; Queue.push v f end
    ) adj.(s)
  done;
  !ordre

La file impose l'ordre « premier découvert, premier traité » : les sommets sortent par distance croissante au départ.

let distances adj depart =
  let n = Array.length adj in
  let dist = Array.make n (-1) in
  let f = Queue.create () in
  dist.(depart) <- 0;
  Queue.push depart f;
  while not (Queue.is_empty f) do
    let s = Queue.pop f in
    List.iter (fun v ->
      if dist.(v) = -1 then begin dist.(v) <- dist.(s) + 1; Queue.push v f end
    ) adj.(s)
  done;
  dist

Le BFS traite les sommets par distance croissante : quand on atteint v pour la première fois, c'est par le plus court chemin, et dist.(v) = dist.(s) + 1. Les sommets inatteignables gardent -1.

let nb_composantes adj =
  let n = Array.length adj in
  let vu = Array.make n false in
  let rec visite s =
    if not vu.(s) then begin vu.(s) <- true; List.iter visite adj.(s) end
  in
  let c = ref 0 in
  for s = 0 to n - 1 do
    if not vu.(s) then begin c := !c + 1; visite s end
  done;
  !c

Chaque sommet encore non vu lance un parcours qui marque toute sa composante ; on en compte ainsi le nombre. Un graphe connexe a une seule composante.

let relies adj a b =
  let vu = accessibles adj a in
  vu.(b)

On parcourt depuis a et l'on regarde si b a été atteint. Réutiliser accessibles rend la fonction triviale : un bon parcours est une brique réutilisable.

let a_cycle adj =
  let n = Array.length adj in
  let vu = Array.make n false in
  let rec visite s pere =
    vu.(s) <- true;
    let rec verifie voisins =
      match voisins with
      | [] -> false
      | v :: reste ->
          if not vu.(v) then visite v s || verifie reste
          else if v <> pere then true        (* déjà vu, <> père : cycle ! *)
          else verifie reste
    in
    verifie adj.(s)
  in
  let rec balaye s =
    if s = n then false
    else if not vu.(s) then visite s (-1) || balaye (s + 1)
    else balaye (s + 1)
  in
  balaye 0

On effectue un DFS en retenant le pere (le sommet d'où l'on vient). Rencontrer un voisin déjà vu qui n'est pas le père signale un cycle (on est revenu sur ses pas par un autre chemin). Le balaye relance sur chaque composante.

let est_biparti adj =
  let n = Array.length adj in
  let couleur = Array.make n (-1) in       (* -1 non colorié, 0 ou 1 *)
  let ok = ref true in
  let f = Queue.create () in
  for depart = 0 to n - 1 do
    if couleur.(depart) = -1 then begin
      couleur.(depart) <- 0;
      Queue.push depart f;
      while not (Queue.is_empty f) do
        let s = Queue.pop f in
        List.iter (fun v ->
          if couleur.(v) = -1 then begin
            couleur.(v) <- 1 - couleur.(s); Queue.push v f
          end
          else if couleur.(v) = couleur.(s) then ok := false
        ) adj.(s)
      done
    end
  done;
  !ok

Un BFS colorie chaque sommet de la couleur opposée à son prédécesseur. Si l'on rencontre un voisin déjà colorié de la même couleur, le graphe n'est pas biparti (il contient un cycle impair). La boucle externe traite toutes les composantes.

let plus_court_chemin adj depart arrivee =
  let n = Array.length adj in
  let pere = Array.make n (-1) in
  let vu = Array.make n false in
  let f = Queue.create () in
  vu.(depart) <- true;
  Queue.push depart f;
  while not (Queue.is_empty f) do
    let s = Queue.pop f in
    List.iter (fun v ->
      if not vu.(v) then begin
        vu.(v) <- true; pere.(v) <- s; Queue.push v f
      end
    ) adj.(s)
  done;
  if not vu.(arrivee) then None
  else
    let rec remonte s =
      if s = depart then [depart] else remonte pere.(s) @ [s]
    in
    Some (remonte arrivee)

On enregistre, lors du BFS, le pere par lequel chaque sommet a été atteint (sur son plus court chemin). On reconstruit ensuite le chemin en remontant les pères de arrivee jusqu'au depart. Même idée que la reconstruction en programmation dynamique (chapitre 13).

let dfs_iteratif adj depart =
  let n = Array.length adj in
  let vu = Array.make n false in
  let p = Stack.create () in
  let ordre = ref [] in
  Stack.push depart p;
  while not (Stack.is_empty p) do
    let s = Stack.pop p in
    if not vu.(s) then begin
      vu.(s) <- true;
      ordre := s :: !ordre;
      List.iter (fun v -> if not vu.(v) then Stack.push v p) adj.(s)
    end
  done;
  !ordre

La pile remplace la pile d'appels de la version récursive. Subtilité : un sommet peut être empilé plusieurs fois (par différents voisins) ; on le marque donc au moment où on le dépile, et l'on ignore les doublons déjà vus. Remplacer la Stack par une Queue transformerait ce DFS en BFS — preuve que c'est la structure (pile ou file) qui distingue les deux parcours.