Vincent Pilaud | Enseignement | Agrégation | Arbres couvrants et théorie algébrique des graphes (Maple)

> restart;

1. POLYNÔME DE TUTTE

Chercher les composantes connexes d'un graphe

> diffsym:=(A,B)->(A minus B) union (B minus A);

> connexe:=proc(G,s)
local U,A,B,i,t;
U:=[{s},{}];
A:={};
for i from 1 to nops(G[2]) do if s in G[2][i][1] and nops(G[2][i][1])=2 then A:=A union {G[2][i][1]} end if; end do;
while A<>{} do
        t:=op(A[1] minus U[1]); U:=[U[1] union {t}, U[2] union {A[1]}]; B:={};
        for i from 1 to nops(G[2]) do if t in G[2][i][1] and nops(G[2][i][1])=2 then B:=B union {G[2][i][1]} end if; end do;
        A:=diffsym(A,B);
end do;
return U;
end proc;

> connexe([{1,2,3,4},{[{1,2},2],[{1},1]}],1);

> compconnexe:=proc(G)
local L,S,U;
L:={};S:=G[1];
while S<>{} do
U:=connexe(G,S[1]); L:=L union {U}; S:=S minus U[1];
end do;
return L;
end proc;

> compconnexe([{1,2,3,4},{[{1,2},2]}],1);

Deux petites procédures pour supprimer et écraser une arête dans un multiensemble :

> supprime:=(G,a)->[G[1],G[2] minus {a} union {seq([a[1],a[2]-1],i=1..min(1,a[2]-1))}];

> ecrase:=proc(G,a)
local M,N,H,i,j,bool;
M:=G[1] minus {a[1][2]};
N:=[];
H:=supprime(G,a);
for i from 1 to nops(H[2]) do
        bool:=true;
        for j from 1 to nops(N) do
                if N[j][1]=subs(a[1][2]=a[1][1],H[2][i][1]) then N[j][2]:=N[j][2]+H[2][i][2]; bool:=false; end if;
        end do;
        if bool then N:=[op(N),[subs(a[1][2]=a[1][1],H[2][i][1]),H[2][i][2]]]; end if;
end do;
return [M,{op(N)}];
end proc;

Polynôme de Tutte

> Tutte:=proc(G)
local a;
if G[2]={} then return 1;
else a:=G[2][1];
        if nops(a[1])=1 then return Y*Tutte(supprime(G,a));
        elif nops(compconnexe(G))<nops(compconnexe(supprime(G,a))) then return X*Tutte(ecrase(G,a));
        else return Tutte(supprime(G,a))+Tutte(ecrase(G,a));
        end if;
end if;
end proc;

> Tutte([{seq(i,i=0..6)},{seq([{i,(i+1 mod 7)},1],i=0..6)}]);

2. ARBRE COUVRANT DE POIDS MINIMAL

Insérer et trier une liste

> insert:=proc(e,L,ordre)
local i;
for i from 1 to nops(L) do
if ordre(e,L[i]) then return [op(1..i-1,L),e,op(i..nops(L),L)]; end if;
end do;
return [op(L),e];
end proc;

> rangement:=proc(L,ordre)
local M,i;
M:=[];
for i from 1 to nops(L) do M:=insert(L[i],M,ordre); end do;
return M;
end proc;

Algorithme de PRIM :
On part d'un point arbitraire, et on fait croitre un arbre à partir de ce point : à chaque étape, on ajoute l'arête de poids minimal qui relie l'arbre déjà construit à un point exterieur.

> ordre:=(u,v)->(u[2]<v[2]);

> prim:=proc(G)
local U,V,W,s,a,R,i;
s:=G[1][1]; U:={s}; V:=G[1] minus U; W:={}; R:={};
while V<>{} do
        for i from 1 to nops(G[2]) do if G[2][i][1] intersect U={s} then W:=insert(G[2][i],W,ordre); end if; end do;
        a:=W[1][1]; s:=op(a intersect V); U:=U union {s}; V:=V minus {s}; R:=R union {a};
        i:=1; while i<=nops(W) do if s in W[i][1] then W:=[op(1..i-1,W),op(i+1..nops(W),W)]; else i:=i+1; end if; end do;
end do;
return [G[1],R];
end proc;

> prim([{0,1,2,3,4,5,6,7,8},{[{0,1},4],[{0,2},8],[{1,2},11],[{1,4},8],[{2,3},7],[{2,8},1],[{3,4},2],[{3,8},6],[{4,5},7],[{4,7},4],[{5,6},9],[{5,7},14],[{6,7},10],[{7,8},2]}]);

Algorithme de KRUSKAL
On part d'une forêt dont chaque arbre est constitué d'un seul sommet. Puis on choisit la plus petite arête qui joint deux sommets appartenant à des arbres différents, et on fusionne les deux arbres. L'algorithme s'arrête lorque la forêt est constitué d'un seul arbre.

> kruskal:=proc(G)
local L,M,a,u,v,i;
L:=map(x->[{x},{}],G[1]);
M:=rangement(G[2],ordre);
while nops(L)>1 do
        a:=M[1][1];
        u:=1; while (a intersect L[u][1])={} do u:=u+1; end do;
        v:=u+1; while (a intersect L[v][1])={} do v:=v+1; end do;
        i:=1; while i<=nops(M) do
                if (M[i][1] intersect L[u][1])<>{} and (M[i][1] intersect L[v][1])<>{}
                then M:=[op(1..i-1,M),op(i+1..nops(M),M)];
                else i:=i+1;
                end if;
        end do;
        L:=L union {[L[u][1] union L[v][1], L[u][2] union L[v][2] union {a}]} minus {L[u],L[v]};
end do;
return op(L);
end proc;

> kruskal([{0,1,2,3,4,5,6,7,8},{[{0,1},4],[{0,2},8],[{1,2},11],[{1,4},8],[{2,3},7],[{2,8},1],[{3,4},2],[{3,8},6],[{4,5},7],[{4,7},4],[{5,6},9],[{5,7},14],[{6,7},10],[{7,8},2]}]);