rigidite.html

> 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);