Plus courts chemins : Dijkstra

let pondere_vide n = Array.make n []

let ajoute_arc adj u v poids = adj.(u) <- (v, poids) :: adj.(u)

let ajoute_arete adj u v poids =        (* non orienté *)
  adj.(u) <- (v, poids) :: adj.(u);
  adj.(v) <- (u, poids) :: adj.(v)

Chaque voisin est un couple (sommet, poids). C'est l'extension naturelle des listes d'adjacence du chapitre 14.

let rec poids_arc adj u v =
  match adj.(u) with
  | [] -> failwith "arête absente"
  | (w, p) :: reste -> if w = v then p else poids_arc_liste reste v
and poids_arc_liste l v =
  match l with
  | [] -> failwith "arête absente"
  | (w, p) :: reste -> if w = v then p else poids_arc_liste reste v

let rec longueur adj chemin =
  match chemin with
  | [] | [_] -> 0
  | u :: (v :: _ as reste) -> poids_arc adj u v + longueur adj reste

On additionne le poids de chaque arête consécutive du chemin. Le motif u :: (v :: _ as reste) (chapitre 9) donne les deux premiers sommets et la queue.

Le relâchement teste si atteindre v en passant par u (distance dist.(u) jusqu'à u, plus le poids de l'arête) est meilleur que la meilleure distance connue à v ; si oui, on met à jour. Dijkstra n'est qu'une discipline de relâchements : relâcher les arêtes des sommets dans l'ordre de leur distance croissante garantit qu'on ne relâche jamais à partir d'une distance non définitive.

let dijkstra adj depart =
  let n = Array.length adj in
  let infini = 1_000_000 in
  let dist = Array.make n infini in
  let traite = Array.make n false in
  dist.(depart) <- 0;
  for _i = 0 to n - 1 do
    let u = ref (-1) in
    for v = 0 to n - 1 do
      if not traite.(v) && dist.(v) < infini
         && (!u = -1 || dist.(v) < dist.(!u)) then u := v
    done;
    if !u <> -1 then begin
      traite.(!u) <- true;
      List.iter (fun (v, poids) ->
        if dist.(!u) + poids < dist.(v) then dist.(v) <- dist.(!u) + poids
      ) adj.(!u)
    end
  done;
  dist

À chaque tour on fige le sommet non traité le plus proche, puis on relâche ses voisins. Les sommets inatteignables conservent infini.

let distance adj a b =
  let dist = dijkstra adj a in
  if dist.(b) >= 1_000_000 then None else Some dist.(b)

On lance Dijkstra depuis a et on lit la case b. La valeur sentinelle infini (restée inchangée) signale l'inaccessibilité, qu'on traduit en None.

Avec des poids tous égaux à 1, la distance pondérée d'un chemin est son nombre d'arêtes. Choisir le sommet non traité de distance minimale revient alors à traiter les sommets par nombre d'arêtes croissant — exactement l'ordre du BFS. Dijkstra généralise donc le BFS aux poids quelconques (positifs) : pour des poids unitaires, le BFS (en $\Theta (n+m)$) est préférable car plus simple et plus rapide.

Dijkstra traite d'abord 0 (relâche : dist.(1) = 2, dist.(2) = 5), puis fige 1 (le plus proche, 2) et relâche dist.(3) = 3, puis fige 3 (3 < 5), et traite 2 en dernier. Ce dernier relâchement ramène dist.(1) à 5 - 4 = 1 (le code relâche sans tester traite), mais 3, déjà figé, n'est plus revu : la fonction renvoie [|0; 1; 5; 3|], alors que la vraie distance de 0 à 3 est 5 - 4 + 1 = 2. Sans l'arc 1 -> 3, l'erreur resterait invisible : le relâchement tardif corrigerait dist.(1) seul. Dijkstra se trompe dès qu'un sommet figé trop tôt a transmis une distance fausse à d'autres : c'est pourquoi Dijkstra suppose les poids positifs.

let dijkstra_peres adj depart =
  let n = Array.length adj in
  let infini = 1_000_000 in
  let dist = Array.make n infini and pere = Array.make n (-1) in
  let traite = Array.make n false in
  dist.(depart) <- 0;
  for _i = 0 to n - 1 do
    let u = ref (-1) in
    for v = 0 to n - 1 do
      if not traite.(v) && dist.(v) < infini
         && (!u = -1 || dist.(v) < dist.(!u)) then u := v
    done;
    if !u <> -1 then begin
      traite.(!u) <- true;
      List.iter (fun (v, poids) ->
        if dist.(!u) + poids < dist.(v) then begin
          dist.(v) <- dist.(!u) + poids;
          pere.(v) <- !u
        end
      ) adj.(!u)
    end
  done;
  (dist, pere)

let chemin adj depart arrivee =
  let (dist, pere) = dijkstra_peres adj depart in
  if dist.(arrivee) >= 1_000_000 then None
  else
    let rec remonte s =
      if s = depart then [depart] else remonte pere.(s) @ [s]
    in
    Some (remonte arrivee)

À chaque relâchement réussi, on note le prédécesseur pere.(v) <- u. On reconstruit le chemin en remontant les pères — exactement comme pour le BFS (chapitre 15) et la programmation dynamique (chapitre 13).

let floyd cout =
  let n = Array.length cout in
  let infini = 1_000_000 in
  let d = Array.make_matrix n n 0 in
  for i = 0 to n - 1 do
    for j = 0 to n - 1 do d.(i).(j) <- cout.(i).(j) done
  done;
  for k = 0 to n - 1 do
    for i = 0 to n - 1 do
      for j = 0 to n - 1 do
        if d.(i).(k) < infini && d.(k).(j) < infini
           && d.(i).(k) + d.(k).(j) < d.(i).(j) then
          d.(i).(j) <- d.(i).(k) + d.(k).(j)
      done
    done
  done;
  d

C'est de la programmation dynamique (chapitre 13) sur les graphes : d.(i).(j) devient le plus court chemin de i à j n'empruntant que des sommets intermédiaires < k+1 ; la boucle sur k (la plus externe) autorise un intermédiaire de plus à chaque fois. Coût $\Theta (n^3)$ ; gère les poids négatifs (sans cycle négatif). La garde évite de « passer par l'infini ».

let bellman_ford n aretes depart =
  let infini = 1_000_000 in
  let dist = Array.make n infini in
  dist.(depart) <- 0;
  for _i = 1 to n - 1 do                 (* n-1 passes *)
    List.iter (fun (u, v, poids) ->
      if dist.(u) < infini && dist.(u) + poids < dist.(v) then
        dist.(v) <- dist.(u) + poids
    ) aretes
  done;
  dist

On relâche toutes les arêtes, n-1 fois de suite. Comme un plus court chemin a au plus n-1 arêtes, n-1 passes suffisent à propager les bonnes distances. Plus lent que Dijkstra ($\Theta (nm)$) mais il gère les poids négatifs (et une n-ième passe qui améliorerait encore révélerait un cycle de poids négatif).