TP 6 : Couplage maximum dans un graphe biparti

Solution

type bipartite = {
  n1 : int;
  adj : int list array
}

type matching = int option array

type path = int list

(* 1 *)
let is_augmenting m path =
  let rec aux = function
  | u::v::q -> m.(u) = Some v && aux q
  | [u] -> m.(u) = None
  | [] -> false in
  match path with
  | u::q -> m.(u) = None && aux q
  | _ -> false

(* 2 *)
let rec delta m path =
  match path with
  | [] | [_] -> ()
  | u::v::q ->
    m.(u) <- Some v;
    m.(v) <- Some u;
    delta m q

(* 3 *)
let orient g m =
  let n = Array.length g.adj in
  let g' = Array.make n [] in
  for i = 0 to g.n1 - 1 do
    let f j =
      if m.(i) = Some j then g'.(j) <- i::g'.(j)
      else g'.(i) <- j::g'.(i) in
    List.iter f g.adj.(i)
  done;
  g'

(* 4 *)
let find_augmenting_path g m =
  let n = 2 * g.n1 in
  let dfs r =
    let vus = Array.make n false in
    let rec aux u = (* renvoie Some p si un chemin augmentant p est trouvé depuis u *)
      if m.(u) = None && u <> r then Some [u]
      else if vus.(u) then None
      else (
        vus.(u) <- true;
        let rec voisins = function
          | [] -> None
          | v::q -> match aux v with
            | None -> voisins vs
            | Some p -> Some (u::p) in
        voisins g.adj.(u)
      ) in
    aux r in
  let rec start_dfs u =
    if u = g.n1 then None
    else match dfs u with
      | None -> start_dfs (u+1)
      | Some p -> Some p in
  start_dfs 0
      
(* 5 *)
let get_maximum_matching g =
  let n = 2 * g.n1 in
  let m = Array.make n None in
  let rec loop () =
    match find_augmenting_path g m with
    | None -> m
    | Some p -> delta m p; loop () in
  loop ()

Dans tout le sujet :

$G = (X\sqcup Y, E)$ désigne un graphe biparti avec $V = X\sqcup Y$ son ensemble de sommets ;
$X = \{0,\dots,n_{1} - 1\}$ , $Y = \{n_{1},\dots, n - 1\}$ : toutes les arêtes relient donc un sommet d'indice strictement inférieur à $n_{1}$ à un sommet d'indice supérieur ou égal à $n_{1}$ ;
on note $p = |E|$ le nombre d'arêtes du graphe ;
on note $A \Delta B = (A \cup B) \setminus (A \cap B)$ la différence symétrique de deux ensembles $A$ et $B$ .

On représente un graphe biparti par le type suivant :

type bipartite = {
  n1 : int;
  adj : int list array
}

Un couplage est représenté par le type suivant :

type matching = int option array

Pour un couplage m, on aura :

m.(i) = None si le sommet $i$ est libre ;
m.(i) = Some j et m.(j) = Some i si les sommets $i$ et $j$ sont appariés.

Un chemin $x_{0}, \dots, x_{k}$ sera simplement représenté par la liste [x0; ...; xk] :

type path = int list

Tests

let g20 = {
  n1 = 20;
  adj =
    [|[37; 34; 32; 31; 25; 22; 20]; [39; 38; 36; 24; 23; 20]; [36; 35; 30; 21];
      [35; 32; 28; 27]; [24; 23; 20]; [37; 34; 32; 27]; [34; 29; 27]; [38; 27];
      [39; 30; 26; 22; 20]; [39; 36]; [36; 31; 28; 27; 26; 25; 24; 23; 22; 21];
      [38; 33; 31]; [29]; [38; 36; 32; 23; 22; 20]; [33; 23]; [24]; [26];
      [39; 26]; [33; 29]; [39; 31; 28; 27]; [13; 8; 4; 1; 0]; [10; 2];
      [13; 10; 8; 0]; [14; 13; 10; 4; 1]; [15; 10; 4; 1]; [10; 0];
      [17; 16; 10; 8]; [19; 10; 7; 6; 5; 3]; [19; 10; 3]; [18; 12; 6];
      [8; 2]; [19; 11; 10; 0]; [13; 5; 3; 0]; [18; 14; 11]; [6; 5; 0];
      [3; 2]; [13; 10; 9; 2; 1]; [5; 0]; [13; 11; 7; 1]; [19; 17; 9; 8; 1]|]
}

(* Un couplage maximal pour l'inclusion, mais pas de cardinalité maximale, *)
(* pour g20. *)

let m20 = [|
  Some 20; Some 23; Some 21; Some 27; Some 24; Some 32; Some 29; Some 38;
  Some 22; Some 36; Some 25; Some 31; None; None; Some 33; None; Some 26;
  Some 39; None; Some 28; Some 0; Some 2; Some 8; Some 1; Some 4; Some 10;
  Some 16; Some 3; Some 19; Some 6; None; Some 11; Some 5; Some 14; None;
  None; Some 9; None; Some 7; Some 17
|]

(* 6 chemins élémentaires de g20. Seul le premier et le dernier sont *)
(* augmentants pour m20. *)

let p20_1 = [30; 8; 22; 0; 20; 1; 23; 14; 33; 11; 31; 19; 28; 3; 27; 6; 29; 12]
let p20_2 = [26; 8; 22; 0; 20; 1; 23; 14; 33; 11; 31; 19; 28; 3; 27; 6; 29; 12]
let p20_3 = [30; 8; 22; 0; 20; 1; 23; 14; 33; 11; 31; 19; 28; 3; 27; 6; 29]
let p20_4 = [30; 8; 22; 0; 20; 1; 23; 14; 33; 11; 31; 19; 28; 3; 27; 6]
let p20_5 = [30; 8; 22; 13; 20; 1; 23; 14; 33; 11; 31; 19; 28; 3; 27; 6; 29; 12]
let p20_6 = [34; 6; 29; 12]

Écrire une fonction is_augmenting prenant en entrée un couplage m et un chemin et indiquant si le chemin est augmentant. On supposera sans le vérifier que le chemin est élémentaire (ne passe pas deux fois par le mêmeet que les entiers sont bien entre 0 et $|m|$ .

is_augmenting m20 p20_1;;
- : bool = true
is_augmenting m20 p20_2;;
- : bool = false
is_augmenting m20 p20_3;;
- : bool = false
is_augmenting m20 p20_4;;
- : bool = false
is_augmenting m20 p20_5;;
- : bool = false
is_augmenting m20 p20_6;;
- : bool = true

Écrire une fonction delta : matching -> path -> unit prenant en entrée un couplage $M$ et un chemin $p$ supposé augmentant pour $M$ et effectuant l'opération $M \leftarrow M \Delta p$ .
Remarque : Pensez à réinitialiser m20 à sa valeur initiale après chaque test.

delta m20 p20_1;;
- : unit = ()
m20;;
- : int option array =
[|Some 22; Some 20; Some 21; Some 28; Some 24; Some 32; Some 27; Some 38;
  Some 30; Some 36; Some 25; Some 33; Some 29; None; Some 23; None; Some 26;
  Some 39; None; Some 31; Some 1; Some 2; Some 0; Some 14; Some 4; Some 10;
  Some 16; Some 6; Some 3; Some 12; Some 8; Some 19; Some 5; Some 11; None;
  None; Some 9; None; Some 7; Some 17|]

Écrire une fonction orient : bipartite -> matching -> int list array prenant en entrée un graphe biparti $G$ $G$ et un couplage $M$ $M$ et renvoyant un graphe orienté $G_{M}$ $G_{M}$ (sous forme d'un int list array) tel que :
- les sommets de $G_{M}$ sont les mêmes que ceux de $G$ ;
- $G_{M}$ $G_{M}$ contient exactement un arc orienté pour chaque arête $\{x, y\}$ ${x, y}$ (avec $x \in X$ $x \in X$ et $y \in Y$ $y \in Y$ ) de $G$ $G$ :
  - si $xy \in M$ , l'arc de $G_{M}$ est $(y, x)$ ;
  - si $xy \notin M$ , l'arc de $G_{M}$ est $(x, y)$ . $G_M$ est donc obtenu à partir de $G$ en orientant les arêtes de $M$ de $X$ vers $Y$ et les autres de $Y$ vers $X$ .

orient g20 m20;;
- : int list array =
[|[22; 25; 31; 32; 34; 37]; [20; 24; 36; 38; 39]; [30; 35; 36]; [28; 32; 35];
  [20; 23]; [27; 34; 37]; [27; 34]; [27]; [20; 26; 30; 39]; [39];
  [21; 22; 23; 24; 26; 27; 28; 31; 36]; [33; 38]; [29];
  [20; 22; 23; 32; 36; 38]; [23]; [24]; []; [26]; [29; 33]; [27; 31; 39]; 
  [0]; [2]; [8]; [1]; [4]; [10]; [16]; [3]; [19]; [6]; []; [11]; [5]; 
  [14]; []; []; [9]; []; [7]; [17]|]

Écrire une fonction find_augmenting_path : bipartite -> matching -> path option prenant en entrée un graphe biparti $G$ et un couplage $M$ et renvoyant :

None si $M$ n'admet pas de chemin augmentant ;
Some p, avec $p$ un chemin augmentant, s'il en existe un.
Pour cela, on utilisera un parcours en profondeur de $G_{M}$ .

- : int list option =
Some [30; 8; 22; 0; 20; 1; 23; 14; 33; 11; 31; 19; 28; 3; 27; 6; 29; 12]

Écrire une fonction maximum_matching : bipartite -> matching renvoyant un couplage maximum pour le graphe biparti $G$ .

maximum_matching g20;;
- : int option array =
[|Some 25; Some 38; Some 35; Some 32; Some 20; Some 37; Some 34; Some 27;
  Some 30; Some 36; Some 21; Some 31; Some 29; Some 22; Some 23; Some 24;
  Some 26; Some 39; Some 33; Some 28; Some 4; Some 10; Some 13; Some 14;
  Some 15; Some 0; Some 16; Some 7; Some 19; Some 12; Some 8; Some 11; 
  Some 3; Some 18; Some 6; Some 2; Some 9; Some 5; Some 1; Some 17|]

Déterminer la complexité de maximum_matching.