Aller au contenu

Couplage maximal dans un graphe biparti

Ce TP accompagne la partie Couplage maximal dans un graphe biparti du chapitre Algorithmique avancée des graphes.

Graphe biparti

On va considérer ici un graphe biparti donné par une liste d'arêtes sous la forme (source,but). Voici un exemple :

[ (0,3); (1,3); (1,4); (2,3); (2,4) ]

En commençant à numéroter à 0, on peut donc supposer que le nombre de sommets est égal au plus grand entier apparaissant dans un couple plus un.

Question 1. Écrire une fonction nombre_sommets : (int * int) list -> int qui calcule ce nombre.

Corrigé 
let rec nombre_sommets l =
    match l with
    | [] -> 0
    | (a,b)::q -> let n = nombre_sommets q in
        max (1 + max a b) n

Pour tester :

assert(nombre_sommets [(0,3);(1,3);(1,4);(2,3);(2,4)] = 5);
assert(nombre_sommets [(0,8);(0,7);(2,6);(2,9);(3,8);(4,8);(4,9);(5,11)] = 12);
"OK"

On va maintenant récupérer la liste des premières composantes et la liste des secondes composantes sans répétition.

Pour cela, on commence par écrire une fonction permettant de réaliser t :: q en omettant t en cas de répétition.

Question 2. Écrire une fonction cons_uniq : 'a -> 'a list -> 'a list telle que cons_uniq t q renvoie t::q si t n'est pas dans la liste q et q sinon.

Corrigé 
let cons_uniq t q =
    if List.mem t q
    then q
    else t::q

Pour tester :

assert(cons_uniq 0 [] = [0]);
assert(cons_uniq 0 [0] = [0]);
assert(cons_uniq 0 [1] = [0;1]);
"OK"

Question 3. Écrire une fonction separe_liste : (int * int) list -> int list * int list qui prend en argument une liste de couples d'entiers et renvoie le couple des listes sans répétitions des premières et secondes composantes.

Corrigé 
let rec separe_liste l =
    match l with
    | [] -> [], []
    | (a,b)::q -> let l1, l2 = separe_liste q in
        (cons_uniq a l1, cons_uniq b l2)

Pour tester :

assert(separe_liste [(0,3);(1,3);(1,4);(2,3);(2,4)] = ([0;1;2],[3;4]));
assert(separe_liste [(0,8);(0,7);(2,6);(2,9);(3,8);(4,8);(4,9);(5,11)] =
    ([0;2;3;4;5],[7;6;8;9;11]));
"OK"

Question 4. Écrire une fonction intersection : 'a list -> 'a list -> 'a list qui prend en arguments deux listes sans répétitions et renvoie une liste contenant les éléments présents dans les deux listes.

Corrigé 
let intersection l1 l2 =
    List.filter (fun x -> List.mem x l2) l1

Pour tester :

assert(intersection [1;2;3] [0;1] = [1]);
assert(intersection [1;2;3] [1;2] = [1;2]);
assert(intersection [1;2;3] [4;5] = []);
assert(intersection [] [3;4] = []);
assert(intersection [1;2;3] [] = []);
"OK"

Question 5. En déduire une fonction biparti : (int * int) list -> bool qui vérifie qu'une liste d'arêtes permet effectivement de représenter un graphe biparti où les sommets sont d'un côté les premières composantes et de l'autre les secondes.

Corrigé 
let biparti l =
    let l1, l2 = separe_liste l in intersection l1 l2 = []

Pour tester :

assert(biparti [(0,3);(1,3);(1,4);(2,3);(2,4)]);
assert(not (biparti [(0,3);(1,0);(1,4);(2,3);(2,4)]));
"OK"

De cette liste d'arêtes représentant un graphe biparti à \(n\) sommets, on va en déduire le graphe lui-même en le représentant sous la forme d'un couple (ladj, sources) où ladj est une représentation en listes d'adjacence et sources est un tableau de booléens indiquant si un sommet appartient à la première partie du graphe biparti, c'est-à-dire s'il est la première composante d'un des couples d'arêtes.

Ainsi, les sommets qui n'apparaissent pas dans les arêtes sont associés implicitement à la seconde partie, ce qui ne sera pas gênant dans la suite.

Question 6. Écrire une fonction graphe_aretes : (int * int) list -> int list array qui renvoie le tableau des listes d'adjacence d'un graphe non orienté donné sous la forme d'une liste d'arêtes.

Corrigé 
let graphe_aretes l =
    let n = nombre_sommets l in
    let ladj = Array.make n [] in
    List.iter (fun (a,b) ->
        ladj.(a) <- b :: ladj.(a); ladj.(b) <- a :: ladj.(b)) l;
    ladj

Pour tester :

assert(graphe_aretes [(0,3);(1,3);(1,4);(2,3);(2,4)]
       = [|[3]; [4; 3]; [4; 3]; [2; 1; 0]; [2; 1]|]);
assert(graphe_aretes [(0,8);(0,7);(2,6);(2,9);(3,8);(4,8);(4,9);(5,11)]
    = [|[7; 8]; []; [9; 6]; [8]; [9; 8]; [11]; [2];
        [0]; [4; 3; 0]; [4; 2]; []; [5]|]);
"OK"

Question 7. En déduire une fonction graphe_biparti : (int * int) list -> int list array * bool array qui renvoie le couple (ladj, sources) représentant le graphe biparti.

Corrigé 
let graphe_biparti l =
    let g = graphe_aretes l in
    let s1, _ = separe_liste l in
    let sources = Array.make (Array.length g) false in
    List.iter (fun i -> sources.(i) <- true) s1;
    g, sources

Pour tester :

assert (snd(graphe_biparti [(0,3);(1,3);(1,4);(2,3);(2,4)])
    = [|true; true; true; false; false|]);
assert(snd(graphe_biparti [(0,8);(0,7);(2,6);(2,9);(3,8);(4,8);(4,9);(5,11)])
    = [|true; false; true; true; true; true; false; false;
        false; false; false; false|]);
"OK"

Couplage maximal

On va programmer l'algorithme pour déterminer un couplage maximal par des bascules successives de chemins augmentants (voir la preuve du théorème de Berge dans le cours).

On va adopter deux représentations d'un couplage. La première est la représentation élémentaire comme sous-liste de la liste d'arêtes du graphe.

Par exemple [ (0,3); (1,4) ] est un couplage pour la liste d'arêtes donnée plus haut.

Question 8. Écrire une fonction est_couplage : (int * int) list -> bool qui vérifie si une liste d'arêtes est un couplage en vérifiant qu'il n'y a pas d'arêtes ayant une extrémité commune.

Votre fonction devra être de complexité linéaire.

Corrigé 
let est_couplage el =
    let n = nombre_sommets el in
    let libres = Array.make n true in
    let couplage = ref true in
    List.iter (fun (x,y) ->
        couplage := !couplage && libres.(x) && libres.(y);
        libres.(x) <- false; libres.(y) <- false) el;
    !couplage

La complexité est linéaire en la longueur de la liste plus le plus grand numéro de sommet, à cause de la création du tableau.

Pour tester :

assert( est_couplage [(0,1);(2,3)] );
assert( not(est_couplage [(0,1);(1,3)]) );
"OK"

L'autre représentation est un tableau indiquant pour un sommet \(i\), soit Some j quand on a une arête \(\{i,j\}\) dans le couplage et None sinon. En effet, un couplage définit une fonction partielle involutive de \(S \rightarrow S\).

Ainsi, le tableau [| Some 3; Some 4; None; Some 0; Some 1 |] permet de représenter le couplage [ (0,3); (1,4) ] en considérant que les sommets sont dans \(\range{0}{4}\).

Question 9. Écrire des fonctions permettant de passer d'une représentation à une autre :

  • couplage_liste_vers_tab : (int * int) list -> int option array ;
  • couplage_tab_vers_liste : bool array -> int option array -> (int * int) list ici, on a besoin de connaître les sources pour choisir comment placer les arêtes.
Corrigé 
let couplage_liste_vers_tab l =
    let n = nombre_sommets l in
    let couplage = Array.make n None in
    List.iter (fun (a,b) ->
        couplage.(a) <- Some b;
        couplage.(b) <- Some a) l;
    couplage

let couplage_tab_vers_liste sources couplage =
    let cpl_aretes = ref [] in
    let n = Array.length sources in
    for i = 0 to n-1 do
        if sources.(i)
        then match couplage.(i) with
             | None -> ()
             | Some j -> cpl_aretes := (i,j) :: !cpl_aretes
    done;
    !cpl_aretes

Attention, couplage_liste_vers_tab renvoie un tableau dont la taille est le nombre de sommets apparaissant dans le couplage, qui peut être inférieur au nombre de sommets du graphe.

Pour tester :

assert( couplage_liste_vers_tab [ (0,3); (1,4) ]
    = [| Some 3; Some 4; None; Some 0; Some 1 |]);
assert( couplage_tab_vers_liste
    [| true; true; true; false; false |]
    [| Some 3; Some 4; None; Some 0; Some 1 |]
    = [ (1,4); (0,3) ]);
"OK"

On va définir ici le graphe résiduel associé à un couplage (voir le cours) de manière implicite avec une fonction permettant de décider si une arête \(x \rightarrow y\) est dans le graphe résiduel. Les arêtes hors du couplage vont des sources vers les buts, celles du couplage des buts vers les sources ; on n'ajoute pas ici les sommets \(s\) et \(t\) du cours.

Attention il peut y avoir des arêtes \(x \rightarrow z\) quand \((x, y)\) est dans le couplage.

Question 10. Écrire une fonction

arete_residuelle : bool array -> int option array -> int -> int -> bool

telle que l'appel arete_residuelle sources couplage x y permette de décider si \(x \rightarrow y\) est dans le graphe résiduel, en supposant que \(\{x, y\}\) est une arête du graphe.

Corrigé 
let arete_residuelle sources couplage x y =
    if sources.(x)
    then couplage.(x) <> Some y
    else couplage.(x) = Some y

Pour tester :

assert(arete_residuelle [|true;false|] [|None;None|] 0 1);
assert(not (arete_residuelle [|true;false|] [|None;None|] 1 0));
assert(arete_residuelle [|true;false|] [|Some 1; Some 0|] 1 0);
assert(not (arete_residuelle [|true;false|] [|Some 1; Some 0|] 0 1));
assert(arete_residuelle [|true;true;false;false|] [|Some 2; None; Some 0; None|] 0 3);
assert(not (arete_residuelle [|true;true;false;false|] [|Some 2; None; Some 0; None|] 0 2));
"OK"

Pour chercher un chemin augmentant, on va commencer par effectuer un parcours en profondeur récursif dans un graphe avec une notion d'arête implicite, une fonction comme arete_residuelle, et on va remplir un tableau de prédécesseurs où \(x\) est le prédécesseur de \(y\) si c'est le DFS depuis \(x\) qui a appelé le DFS depuis \(y\).

Dans toute la suite, on suppose que le prédécesseur de \(x\) est \(x\) lui-même quand on a lancé le DFS initialement depuis le sommet \(x\).

Question 11. Écrire une fonction

dfs : int list array -> (int -> int -> bool) -> int option array -> int -> unit

telle que dfs g est_arete pred x effectue un DFS depuis le sommet x dans le graphe donné sous forme de listes d'adjacence par g, avec une fonction est_arete permettant de tester si une arête est à considérer dans le parcours et en remplissant le tableau des prédécesseurs pred, qui est un int option array car la valeur vaut None tant que le sommet n'est pas découvert.

Rappel : on a spécifié que pred.(x) valait Some x si x était un des sommets initiaux sur lesquels on a commencé le DFS.

Corrigé 
let rec dfs g est_arete pred x =
    List.iter (fun y ->
        if pred.(y) = None && est_arete x y
        then begin
            pred.(y) <- Some x;
            dfs g est_arete pred y
        end)
        g.(x)

C'est à l'appelant d'initialiser pred.(x) à Some x avant l'appel initial.

Question 12. Écrire une fonction

remonte : int option array -> int -> int list

telle que remonte pred x renvoie la liste des sommets allant du point de départ d'un DFS ayant rempli pred jusqu'à x en remontant la relation de prédécesseurs.

Corrigé 
let remonte pred x =
    let rec aux pred y acc =
        match pred.(y) with
        | None -> failwith "Impossible"
        | Some x when x = y -> y::acc
        | Some x -> aux pred x (y::acc)
    in
    aux pred x []

On considère qu'on a effectué un DFS dans le graphe résiduel associé à un couplage depuis un sommet et on cherche maintenant à écrire une fonction qui permet de déterminer s'il existe un chemin depuis ce sommet vers un sommet libre parmi les buts, c'est-à-dire les sommets qui ne sont pas des sources.

Question 13. Écrire une fonction

cherche_chemin : int option array -> bool array -> int option array -> int -> int list option

telle que cherche_chemin pred sources couplage depart renvoie Some phi si phi est la liste des sommets visités dans un chemin du graphe résiduel de depart à un sommet but libre pour couplage et None sinon.

Corrigé 
let cherche_chemin pred sources couplage depart =
    let rec aux i =
        if i = Array.length sources
        then None
        else if not sources.(i) && couplage.(i) = None
                                && pred.(i) <> None
             then let phi = remonte pred i in
                  if List.hd phi = depart
                  then Some phi
                  else aux (i+1)
             else aux (i+1)
    in
    aux 0

Si le DFS n'a été lancé que depuis depart, le test List.hd phi = depart est toujours vrai ; il protège le cas où pred proviendrait de plusieurs DFS.

Question 14. Écrire une fonction

chemin_augmentant : int list array -> bool array -> int option array -> int -> int list option

telle que chemin_augmentant g sources couplage depart renvoie Some phi où phi est la liste des sommets d'un chemin augmentant issu de la source libre depart (et donc arrivant nécessairement dans un sommet but libre), et None s'il n'en existe pas.

Corrigé 
let chemin_augmentant g sources couplage depart =
    let n = Array.length g in
    let pred = Array.make n None in
    pred.(depart) <- Some depart;
    dfs g (arete_residuelle sources couplage) pred depart;
    cherche_chemin pred sources couplage depart

Le chemin obtenu est élémentaire car il suit l'arbre du parcours, et il alterne entre arêtes hors du couplage (des sources vers les buts) et arêtes du couplage (des buts vers les sources) : c'est bien un chemin augmentant d'après la partie du cours sur le graphe résiduel.

Question 15. Écrire une fonction

bascule_chemin : int option array -> int list -> unit

telle que bascule_chemin couplage chemin, où chemin est un chemin augmentant pour le couplage, va faire la bascule de toutes les arêtes de chemin : celles dans le couplage sont enlevées et celles qui n'y sont pas sont rajoutées.

Indice : seule la parité permet de déterminer celles qui y sont dans la mesure où on a un chemin augmentant.

Corrigé 
let rec bascule_chemin couplage chemin =
    match chemin with
    | s::t::q -> couplage.(s) <- Some t; couplage.(t) <- Some s; bascule_chemin couplage q
    | [] -> ()
    | [_] -> failwith "Le chemin a forcément un nombre pair de sommets"

Il suffit d'ajouter les arêtes de rang impair : chaque sommet du chemin reçoit un nouveau partenaire, ce qui écrase automatiquement les anciennes arêtes du couplage, de rang pair.

Question 16. En déduire une fonction

couplage_maximal : (int * int) list -> (int * int) list

telle que couplage_maximal aretes, où aretes est un graphe biparti donné sous forme d'une liste d'arêtes, renvoie un couplage maximal sous la forme d'une liste d'arêtes.

Pour cela, on va itérer sur chaque sommet source en cherchant un chemin augmentant depuis celui-ci et en le basculant. Quand on aura traité toutes les sources, on est certain qu'il n'y a plus de chemin augmentant (c'est l'objet de la dernière propriété de la partie Déterminer un chemin augmentant dans un graphe biparti du cours).

Corrigé 
let couplage_maximal l =
    let g, sources = graphe_biparti l in
    let n = Array.length g in
    let couplage = Array.make n None in
    for i = 0 to n-1 do
        if sources.(i) && couplage.(i) = None
        then match chemin_augmentant g sources couplage i with
           | None -> ()
           | Some ch -> bascule_chemin couplage ch
    done;
    couplage_tab_vers_liste sources couplage

Il y a au plus \(|S|\) recherches de chemin, chacune en \(O(|S| + |A|)\), d'où une complexité en \(O(|S|(|S| + |A|))\).

Pour tester :

assert(couplage_maximal [(0,3);(1,3);(1,4);(2,3);(2,4)]
    = [(1,4);(0,3)]);
assert(couplage_maximal [(0,8);(0,7);(2,6);(2,9);(3,8);(4,8);(4,9);(5,11)]
    = [(5, 11); (4, 9); (3, 8); (2, 6); (0, 7)]);
"OK"

Remarque

Pour tester plus sérieusement couplage_maximal, on peut le comparer avec une fonction naïve qui calcule récursivement la taille maximale d'un couplage : pour la première arête \(\{a, b\}\) de la liste, soit on ne la prend pas, soit on la prend et on retire toutes les arêtes touchant \(a\) ou \(b\). Sur des milliers de petits graphes bipartis aléatoires, on vérifie que le résultat est un couplage, formé d'arêtes du graphe, et de même taille que celui de la fonction naïve.