Files de priorité : le tas binaire

Parent de 4 : (4-1)/2 = 1 ; fils gauche : 2*4+1 = 9 ; fils droit : 10. Pour [|1;3;2;7;5|] : racine 1, enfants 3 et 2 ; enfants de 3 (indice 1) : 7 et 5. Chaque nœud est $\le$ ses enfants ($1\le 3,2$ ; $3\le 7,5$) : c'est bien un tas, de minimum 1.

let cree capacite = { taille = 0; donnees = Array.make capacite 0 }
let est_vide t = t.taille = 0
let minimum t = if est_vide t then failwith "tas vide" else t.donnees.(0)

minimum se lit en donnees.(0) (la racine) en temps constant : c'est l'invariant du tas. La capacité fixe le nombre maximal d'éléments (tableau de taille fixe).

let insere t x =
  let d = t.donnees in
  d.(t.taille) <- x;
  t.taille <- t.taille + 1;
  let i = ref (t.taille - 1) in
  while !i > 0 && d.((!i - 1) / 2) > d.(!i) do
    let p = (!i - 1) / 2 in
    let tmp = d.(!i) in d.(!i) <- d.(p); d.(p) <- tmp;
    i := p
  done

On place 0 en indice 3 : [|1;3;2;0|]. Son parent (indice 1) est 3 > 0 : on échange → [|1;0;2;3|]. Le nouveau parent (indice 0) est 1 > 0 : on échange → [|0;1;2;3|]. 0 est remonté à la racine : c'est le nouveau minimum.

let extrait_min t =
  if est_vide t then failwith "tas vide";
  let d = t.donnees in
  let mini = d.(0) in
  t.taille <- t.taille - 1;
  d.(0) <- d.(t.taille);
  let i = ref 0 and continuer = ref true in
  while !continuer do
    let g = 2 * !i + 1 and dr = 2 * !i + 2 in
    let petit = ref !i in
    if g < t.taille && d.(g) < d.(!petit) then petit := g;
    if dr < t.taille && d.(dr) < d.(!petit) then petit := dr;
    if !petit <> !i then begin
      let tmp = d.(!i) in d.(!i) <- d.(!petit); d.(!petit) <- tmp; i := !petit
    end
    else continuer := false
  done;
  mini

On renvoie la racine, on y remonte la dernière feuille, puis on la fait redescendre vers le plus petit enfant tant qu'elle est trop grande. Les tests g < t.taille et dr < t.taille vérifient l'existence des enfants.

let est_un_tas d n =
  let ok = ref true in
  for i = 1 to n - 1 do
    if d.((i - 1) / 2) > d.(i) then ok := false   (* parent > enfant : violé *)
  done;
  !ok

Il suffit de vérifier, pour chaque nœud i (sauf la racine), qu'il n'est pas plus petit que son parent. Parcourir une seule fois les indices 1..n-1 suffit : chaque relation parent-enfant est ainsi testée. Coût $\Theta (n)$.

let tri_par_tas arr =
  let n = Array.length arr in
  let t = cree n in
  for i = 0 to n - 1 do insere t arr.(i) done;       (* tout insérer *)
  for i = 0 to n - 1 do arr.(i) <- extrait_min t done (* extraire dans l'ordre *)

On insère tous les éléments dans un tas, puis on les extrait : l'extraction du minimum à répétition les rend dans l'ordre croissant. $n$ insertions et $n$ extractions, chacune en $\Theta (\log n)$, soit $\Theta (n\log n)$ — la même garantie que le tri fusion (chapitre 9).

let k_plus_petits arr k =
  let n = Array.length arr in
  let t = cree n in
  for i = 0 to n - 1 do insere t arr.(i) done;
  let rec extraire j = if j = 0 then [] else extrait_min t :: extraire (j - 1) in
  extraire k

On bâtit un tas de tous les éléments, puis on en extrait les k plus petits (les premiers à sortir). Coût $\Theta (n\log n)$ ; on pourrait viser $\Theta (n+k\log n)$ avec une construction de tas en $\Theta (n)$ (exercice 8).

let descendre d n i0 =       (* percoler le nœud i0 vers le bas dans d.(0..n-1) *)
  let i = ref i0 and continuer = ref true in
  while !continuer do
    let g = 2 * !i + 1 and dr = 2 * !i + 2 in
    let petit = ref !i in
    if g < n && d.(g) < d.(!petit) then petit := g;
    if dr < n && d.(dr) < d.(!petit) then petit := dr;
    if !petit <> !i then begin
      let tmp = d.(!i) in d.(!i) <- d.(!petit); d.(!petit) <- tmp; i := !petit
    end
    else continuer := false
  done

let construit d n =
  for i = n / 2 - 1 downto 0 do descendre d n i done

On percole chaque nœud interne (indices n/2 - 1 à 0), des feuilles vers la racine : quand on traite i, ses sous-arbres sont déjà des tas. L'analyse fine donne un coût total $\Theta (n)$ (et non $\Theta (n\log n)$). Remarque : OCaml propose downto ; si l'on s'en tient au seul to, on parcourt i de 0 à n/2-1 et l'on descend n/2 - 1 - i.

type tas_couples = { mutable taille : int; donnees : (int * int) array }

let cree_c capacite = { taille = 0; donnees = Array.make capacite (0, 0) }

let insere_c t x =
  let d = t.donnees in
  d.(t.taille) <- x; t.taille <- t.taille + 1;
  let i = ref (t.taille - 1) in
  while !i > 0 && fst d.((!i - 1) / 2) > fst d.(!i) do
    let p = (!i - 1) / 2 in
    let tmp = d.(!i) in d.(!i) <- d.(p); d.(p) <- tmp; i := p
  done

Tout est identique au tas d'entiers, mais on compare la première composante (fst, la distance) : le couple de plus petite distance remonte à la racine. extrait_min s'adapte de même (comparer par fst). On dispose alors d'une file de priorité « distance, sommet ».

let dijkstra_tas adj depart n_aretes =
  let n = Array.length adj in
  let infini = 1_000_000 in
  let dist = Array.make n infini in
  let t = cree_c (n + n_aretes) in       (* capacité : assez de poussées *)
  dist.(depart) <- 0;
  insere_c t (0, depart);
  while t.taille > 0 do
    let (du, u) = extrait_min_c t in
    if du = dist.(u) then               (* ignorer les entrées périmées *)
      List.iter (fun (v, poids) ->
        if du + poids < dist.(v) then begin
          dist.(v) <- du + poids;
          insere_c t (dist.(v), v)       (* on pousse la nouvelle distance *)
        end
      ) adj.(u)
  done;
  dist

Au lieu de chercher le minimum en $\Theta (n)$, on l'extrait du tas en $\Theta (\log n)$. À chaque relâchement réussi, on pousse le couple (nouvelle_distance, v) ; une même destination peut être poussée plusieurs fois, d'où le test du = dist.(u) qui ignore les entrées périmées. Coût $\Theta ((n+m)\log n)$ — bien meilleur que le $\Theta (n^2)$ du chapitre 16 sur les graphes creux. (extrait_min_c est la version « couples » de extrait_min.)