Parcours en largeur

Preuve de correction

(par Jean-Baptiste Bianquis)

Graphe utilisé pour les exemples :

let g_mat = [|
    [|0; 0; 0; 0; 0; 0; 1|];
    [|0; 0; 1; 1; 1; 0; 0|];
    [|0; 1; 0; 0; 1; 1; 0|];
    [|0; 1; 0; 0; 1; 0; 0|];
    [|0; 0; 1; 1; 0; 0; 0|];
    [|0; 0; 1; 0; 1; 0; 0|];
    [|1; 0; 0; 0; 0; 0; 0|];
|]

let g_list = [|[6]; [2; 3; 4]; [1; 4; 5]; [1; 4]; [1; 2; 3; 5]; [4; 2]; [0]|]

val g_mat : int array array =
  [|[|0; 0; 0; 0; 0; 0; 1|]; [|0; 0; 1; 1; 1; 0; 0|];
    [|0; 1; 0; 0; 1; 1; 0|]; [|0; 1; 0; 0; 1; 0; 0|];
    [|0; 0; 1; 1; 0; 0; 0|]; [|0; 0; 1; 0; 1; 0; 0|];
    [|1; 0; 0; 0; 0; 0; 0|]|]

val g_list : int list array =
  [|[6]; [2; 3; 4]; [1; 4; 5]; [1; 4]; [1; 2; 3; 5]; [4; 2]; [0]|]

Les fonctions suivantes ont été écrites pour un graphe représenté par liste d’adjacence.

Exercice

Réécrire ces fonctions pour une matrice d’adjacence.

Parcours en largeur sur liste d’adjacence

Avec file

let bfs (g : int list array) (r : int) =
    let seen = Array.make (Array.length g) false in
    let q = Queue.create () in
    let add v = 
        if not seen.(v) then (
            seen.(v) <- true; Queue.add v q
        ) in
    add r;
    while not (Queue.is_empty q) do
        let u = Queue.pop q in
        Printf.printf "Sommet %d visité\n%!" u;
        List.iter add g.(u)
    done

val bfs : int list array -> int -> unit = <fun>

let () = bfs g_list 3

Sommet 3 visité
Sommet 1 visité
Sommet 4 visité
Sommet 2 visité
Sommet 5 visité

Avec deux couches

let bfs g r =
    let seen = Array.make (Array.length g) false in
    let rec aux cur next = match cur with
        | [] -> if next <> [] then aux next []
        | u::q when seen.(u) -> aux q next
        | u::q -> seen.(u) <- true;
                  Printf.printf "Sommet %d visité\n%!" u;
                  aux q (next @ g.(u)) in
    aux [r] []

val bfs : int list array -> int -> unit = <fun>

let () = bfs g_list 3

Sommet 3 visité
Sommet 1 visité
Sommet 4 visité
Sommet 2 visité
Sommet 5 visité

Calcul de distances

Remarque : le parcours en largeur ne sert à trouver les distances que si le graphe est non pondéré, et où la longueur d’un chemin est son nombre d’arêtes. Sur les graphes pondérés, il faut utiliser Dijkstra/Floyd-Warshall/Bellman-Ford…

Avec une file

let distances g r =
    let dist = Array.make (Array.length g) (-1) in
    let q = Queue.create () in
    let add d v =
        if dist.(v) = -1 then (
            dist.(v) <- d; 
            Queue.add (v, d) q
        ) in
    add 0 r;
    while not (Queue.is_empty q) do
        let u, d = Queue.pop q in
        List.iter (add (d + 1)) g.(u)
    done;
    dist (* dist.(u) est la distance de r à u *)

val distances : int list array -> int -> int array = <fun>

distances g_list 1

- : int array = [|-1; 0; 1; 1; 1; 2; -1|]

Avec deux couches

let distances g r =
    let dist = Array.make (Array.length g) (-1) in
    let rec aux d cur next = match cur with
        | [] -> if next <> [] then aux (d + 1) next []
        | u::q when dist.(u) <> -1 -> aux d q next
        | u::q -> dist.(u) <- d;
                  aux d q (g.(u) @ next) in
    aux 0 [r] []; 
    dist (* dist.(u) est la distance de r à u *)

val distances : int list array -> int -> int array = <fun>

distances g_list 1

- : int array = [|-1; 0; 1; 1; 1; 2; -1|]

Plus courts chemins

let bfs g r =
    let pred = Array.make (Array.length g) (-1) in
    let q = Queue.create () in
    let add p v = (* p est le père de v *)
        if pred.(v) = -1 then (pred.(v) <- p; Queue.add v q) in
    add r r;
    while not (Queue.is_empty q) do
        let u = Queue.pop q in
        List.iter (add u) g.(u)
    done; 
    pred (* pred.(v) est le prédécesseur de v dans le parcours en largeur *)

val bfs : int list array -> int -> int array = <fun>

let rec path pred v = (* renvoie la liste inversée des sommets du chemin parcouru par le BFS pour aller de la racine à v *)
    if pred.(v) = v then [v]
    else v::path pred pred.(v)

val path : int array -> int -> int list = <fun>

let pred = bfs g_list 3

val pred : int array = [|-1; 3; 1; 3; 3; 4; -1|]

path pred 5 (* chemin de 3 à 5 (à l'envers) *)

- : int list = [5; 4; 3]