> | restart: |
> | with(LinearAlgebra):with(linalg): |
COLORIAGE DE GRAPHES
6-COLORIAGE
On commence par un algorithme qui 6-colorie un graphe. Pour cela, on trouve un sommet de degré inférieur ou égal à 5, on 6-colorie le graphe privé de ce sommet, puis on colorie ce sommet de la couleur qui n'apparait pas autour de lui. On représente les graphes par leur matrice d'adjacence.
> | degrecinq:=proc(M)
local n,i; n:=RowDimension(M); for i from 1 to n do if add(M[i,j],j=1..n)<=5 then return i; end if;end do; return "graphe certainement non planaire"; end proc; |
> | sixcoloriage:=proc(M)
local i,L,n,C,j; n:=RowDimension(M); if n<=6 then return [seq(i,i=1..n)] end if; i:=degrecinq(M); if not(type(i,integer)) then return "graphe certainement non planaire"; end if; L:=sixcoloriage(SubMatrix(M,[1..(i-1),(i+1)..n],[1..(i-1),(i+1)..n])); C:={1,2,3,4,5,6}; for j from 1 to i-1 do if M[i,j]=1 then C:=C minus {L[j]}; end if; end do; for j from i+1 to n do if M[i,j]=1 then C:=C minus {L[j-1]}; end if; end do; return [op(1..i-1,L),C[1],op(i..n-1,L)]; end proc; |
Donnons un exemple : pour ce graphe en forme de fleur...
...on aura cette matrice :
> | N:=Matrix([[0,1,1,0,1,0,0,0,1,0,1,1,0],[1,0,1,1,0,0,0,0,0,0,0,1,1],[1,1,0,1,1,0,0,0,0,0,0,0,0],[0,1,1,0,1,1,0,0,0,0,0,0,1],[1,0,1,1,0,1,1,0,1,0,0,0,0],[0,0,0,1,1,0,1,1,0,0,0,0,1],[0,0,0,0,1,1,0,1,1,0,0,0,0],[0,0,0,0,0,1,1,0,1,1,0,0,1],[1,0,0,0,1,0,1,1,0,1,1,0,0],[0,0,0,0,0,0,0,1,1,0,1,1,1],[1,0,0,0,0,0,0,0,1,1,0,1,0],[1,1,0,0,0,0,0,0,0,1,1,0,1],[0,1,0,1,0,1,0,1,0,1,0,1,0]]); |
> | sixcoloriage(N); |
Ceci nous donne le 5-coloriage suivant :
COMPOSANTE CONNEXE
Voici maintenant une procédure qui calcule la composante connexe d'un point dans un graphe. On travaille de proche en proche.
> | connexe:=proc(M,l)
local K,L,i,j,n; n:=RowDimension(M); K:={l};L:={}; while K<>{} do i:=K[1]; K:=K minus {i}; L:=L union {i}; for j from 1 to n do if M[i,j]<>0 and not(j in L) then K:=K union {j}; end if; end do;end do; return L; end proc; |
Considérons par exemple la matrice d'adjacence de ce graphe :
> | N:=Matrix([[0,1,1,1,0,0,0,0,0],[1,0,0,1,0,0,0,0,0],[1,0,0,1,0,0,0,0,0],[1,1,1,0,0,0,0,0,0],[0,0,0,0,0,0,1,0,0],[0,0,0,0,0,0,1,0,0],[0,0,0,0,1,1,0,1,1],[0,0,0,0,0,0,1,0,1],[0,0,0,0,0,0,1,1,0]]); |
> | connexe(N,2);connexe(N,5); |
La procédure fournit bien les composantes connexes de 2 et de 5.
5-COLORIAGE
Voici maintenant une procédure pour 5-colorier un graphe. On suppose donné le graphe par une matrice d'adjacence un peu spéciale : dans la ligne i, on remplace les 1 correspondants aux sommets adjacents à i par le numéro des sommets adjacents triés dans l'ordre trigonométrique.
On commence par redéfinir la procédure permettant de trouver un sommet de degré au plus 5.
> | nonnul:=i->min(abs(i),1); |
> | degrecinq:=proc(M)
local n,i; n:=RowDimension(M); for i from 1 to n do if add(nonnul(M[i,j]),j=1..n)<=5 then return i; end if;end do; return "graphe certainement non planaire"; end proc; |
On définit maintenant une procédure qui prend en entrée une matrice M, un sommet i et un coloriage de M\i (attention : on a oublié i dans ce coloriage, donc il faut bien penser à décaler les indices ensuite) et qui nous donne les sommets et leurs couleurs qui apparaissent dans l'ordre trigonométrique autour du point i.
> | pluspetit:=(i,j)->nonnul(i-j-abs(i-j)); |
> | ordretrigo:=proc(M,i,L)
local n,j,l,P,Q,R; n:=RowDimension(M); P:=[];Q:=[];R:=[]; for j from 1 to n do if M[i,j]<>0 then l:=1; while l<nops(P) and M[i,j]<P[l] do l:=l+1; end do; P:=[op(1..l-1,P),M[i,j],op(l..nops(P),P)]; Q:=[op(1..l-1,Q),j,op(l..nops(Q),Q)]; R:=[op(1..l-1,R),L[j-pluspetit(i,j)],op(l..nops(R),R)]; end if;end do; return(Q,R); end proc; |
J'ai encore besoin d'une procédure qui cherche la place d'un élément dans une liste.
> | place:=proc(L,i)
local j; for j from 1 to nops(L) do if L[j]=i then return j; end if; end do; return "élément absent de la liste"; end proc; |
Je peux maintenant écrire mon programme :
> | cinqcoloriage:=proc(M)
local n,i,j,p,C,L,O,K,U; n:=RowDimension(M); if n<=5 then return [seq(i,i=1..n)] end if; i:=degrecinq(M); if not(type(i,integer)) then return "graphe certainement non planaire"; end if; L:=cinqcoloriage(SubMatrix(M,[1..(i-1),(i+1)..n],[1..(i-1),(i+1)..n])); O:=ordretrigo(M,i,L); C:={1,2,3,4,5}; for j from 1 to nops(O[2]) do C:=C minus {O[2][j]}; end do; if C<>{} then return [op(1..(i-1),L),C[1],op(i..nops(L),L)]; else U:=[]; for j from 1 to n do if L[j-pluspetit(i,j)]=O[2][1] or L[j-pluspetit(i,j)]=O[2][3] then U:=[op(U),j]; end if; end do; K:=connexe(SubMatrix(M,U,U),place(U,O[1][1])); if not(place(U,K[1][3])) in K then for j from 1 to nops(K) do p:=U[K[j]]; if L[p-pluspetit(i,j)]=O[2][1] then L[p-pluspetit(i,j)]:=O[2][3] else L[p-pluspetit(i,j)]=O[2][1]; end if; end do; return [op(1..(i-1),L),O[2][1],op(i..nops(L),L)]; else U:=[]; for j from 1 to n do if L[j-pluspetit(i,j)]=O[2][2] or L[j-pluspetit(i,j)]=O[2][4] then U:=[op(U),j]; end if; end do; K:=connexe(SubMatrix(M,U,U),place(U,O[1][2])); for j from 1 to nops(K) do p:=U[K[j]]; if L[p-pluspetit(i,j)]=O[2][2] then L[p-pluspetit(i,j)]:=O[2][4] else L[p-pluspetit(i,j)]=O[2][2]; end if; end do; return [op(1..(i-1),L),O[2][2],op(i..nops(L),L)]; end if; end if; end proc; |
Donnons un exemple : pour ce graphe en forme de fleur...
...on aura cette matrice :
> | N:=Matrix([[0,3,2,0,1,0,0,0,6,0,5,4,0],[5,0,1,2,0,0,0,0,0,0,0,4,3],[4,3,0,2,1,0,0,0,0,0,0,0,0],[0,4,5,0,1,2,0,0,0,0,0,0,3],[3,0,2,1,0,6,5,0,4,0,0,0,0],[0,0,0,5,1,0,2,3,0,0,0,0,4],[0,0,0,0,2,1,0,4,3,0,0,0,0],[0,0,0,0,0,2,3,0,4,5,0,0,1],[4,0,0,0,3,0,2,1,0,6,5,0,0],[0,0,0,0,0,0,0,4,5,0,1,2,3],[1,0,0,0,0,0,0,0,4,3,0,2,0],[1,2,0,0,0,0,0,0,0,4,5,0,3],[0,1,0,2,0,3,0,4,0,5,0,6,0]]); |
Ceci nous donne le 5-coloriage suivant :