> | restart: |
1. GÉNÉRALITÉS
On commence par l'algorithme naïf Laman pour tester si un graphe est de Laman.
> | Laman:=proc(G)
local S,A,i,j,k,P,p,q; S:=G[1]; A:=G[2]; if nops(A)<>2*nops(S)-3 then return false; end if; P:=[seq(0,i=1..nops(S))]; for i from 1 to 2^(nops(S))-1 do j:=1; while P[j]=1 do P[j]:=0; j:=j+1; end do; P[j]:=1; p:=add(P[k],k=1..nops(P)); q:=0; for k from 1 to nops(A) do if P[A[k][1]]=1 and P[A[k][2]]=1 then q:=q+1; end if; end do; if p>1 and q>2*p-3 then return false; end if; end do; return true; end proc; |
> | G1:=[{1,2,3,4,5},{{1,2},{1,3},{1,5},{2,3},{2,4},{3,5},{4,5}}]; Laman(G1);
G2:=[{1,2,3,4,5},{{1,2},{1,3},{1,5},{2,3},{2,4},{3,5},{2,5}}]; Laman(G2); |
La procédure Henneberg construit des graphes de Laman par les deux constructions d'Henneberg.
> | Henneberg:=proc(n)
local A,i,b,r,s,a; A:={{1,2},{2,3},{3,1}}; for i from 1 to n-3 do b:=rand(2)(); if b=0 then r:=rand(1..i+1)(); s:=rand(r+1..i+2)(); A:=A union {{r,i+3},{s,i+3}}; else a:=sort(A[rand(1..2*i+1)()]); r:=rand(1..i)(); if a[1]<=r then r:=r+1; end if; if a[2]<=r then r:=r+1; end if; A:=A minus {a} union {{a[1],i+3},{a[2],i+3},{r,i+3}}; end if; end do; return [{seq(i,i=1..n)},A]; end proc; |
2. PEBBLE GAME
On va avoir besoin des trois procédures suivantes :
- outdegree teste si tous les sommets de Z sont de degré sortant 2,
- remonte permet de trouver un chemin C de {r,s} à un point z en utilisant les arêtes de Y,
- supprime efface un élément e d'une liste L.
> | outdegree:=(G,Z)->convert({seq(nops(G[Z[i]])=2,i=1..nops(Z))},`and`); |
> | remonte:=proc(Y,z)
local i; for i from 1 to nops(Y) do if Y[i][2]=z then return([op(remonte(Y[1..i-1],Y[i][1])),z]); end if; end do; return([z]); end proc; |
> | supprime:=proc(L,e)
local i; for i from 1 to nops(L) do if L[i]=e then return([op(L[1..i-1]),op(L[i+1..nops(L)])]); end if; end do; end proc; |
On peut maintenant écrire la procédure pebble.
> | pebble:=proc(G,r,s)
local X,Y,Z,ZZ,V,C,i,j,GG; X:={r,s}; Y:=[]; Z:={r,s}; while outdegree(G,Z) do ZZ:={}; for i from 1 to nops(Z) do V:={op(G[Z[i]])} minus X; X:=X union V; Y:=[op(Y),seq([Z[i],V[j]],j=1..nops(V))] ; ZZ:=ZZ union V; end do; Z:=ZZ; if Z={} then return [false,X]; end if; end do; for i from 1 to nops(Z) do if nops(G[Z[i]])<2 then C:=remonte(Y,Z[i]); GG:=G; for j from 1 to nops(C)-1 do GG[C[j]]:=supprime(GG[C[j]],C[j+1]); GG[C[j+1]]:=[op(GG[C[j+1]]),C[j]]; end do; GG[C[1]]:=[op(GG[C[1]]),op({r,s} minus {C[1]})]; return([true,GG]); end if; end do; end proc; |
> | H1:=[[3,6],[3,6],[4,4],[5,6],[3,4],[5,5]]; pebble(H1,1,2);
H2:=[[3,6],[3,6],[4,4],[5,6],[3],[5,5]]; pebble(H2,1,2); |
La procédure rigide permet alors de tester efficacement si un graphe est rigide en dimension 2.
> | rigide:=proc(G)
local S,A,H,HH,a,i,bool; S:=G[1]; A:=G[2]; H:=[seq([],i=1..nops(S))]; while A<>{} do a:=A[1]; A:=A[2..nops(A)]; bool:=true; i:=0; HH:=H; while bool and i<4 do HH:=pebble(HH,op(a)); i:=i+1; bool:=HH[1]; HH:=HH[2]; end do; if bool then H:=pebble(H,op(a))[2]; end if; end do; return(evalb(add(nops(H[i]),i=1..nops(H))=2*nops(S)-3)); end proc; |
> | rigide(G1); rigide(G2); |