Vincent Pilaud | Enseignement | Agrégation

> restart:

> with(plots):
with(plottools):

1. LES SOLIDES DE PLATON

> plots[display](tetrahedron([0,0,0],0.8,transparency=.5),orientation=[60,50]);

> plots[display](cuboid([0,0,0],[1,1,1],transparency=.5),orientation=[70,70]);

> plots[display](octahedron([0,0,0],0.8,transparency=.5),orientation=[50,70]);

> plots[display](dodecahedron([0,0,0],0.8,transparency=.5),orientation=[45,0]);

> plots[display](icosahedron([0,0,0],0.8,transparency=.5),orientation=[10,0]);

> plot(2*x/(x-2),x=3..10);

> s:=(p,q)->4*p/(2*p+2*q-p*q);a:=(p,q)->2*p*q/(2*p+2*q-p*q);f:=(p,q)->4*q/(2*p+2*q-p*q);

> [s(5,3),a(5,3),f(5,3)];
[s(4,3),a(4,3),f(4,3)];
[s(3,3),a(3,3),f(3,3)];
[s(3,4),a(3,4),f(3,4)];
[s(3,5),a(3,5),f(3,5)];

2. POLYNÔME INDICATEUR DE CYLES

On commence par une procédure qui transforme une permutation donnée sous forme d'une liste (L[i] est simplement l'image i par la permutation) en un produit de cycles à supports disjoints (on donne la liste des cycles).

> tabletocycles:=proc(T)
local p,L,u;
p:=[];
L:={seq(i,i=1..nops(T))};
while L<>{} do
        u:=L[1];
        p:=[op(p),[u]];L:=L minus {u};
        while T[u]<>p[nops(p)][1] do
                u:=T[u];
                p[nops(p)]:=[op(p[nops(p)]),u];
                L:=L minus {u};
        end do;
end do;
return p;
end proc;

Voici maintenant une procédure qui donne la liste des permutations du groupe diedral D_2n sous forme de cycles à supports disjoints :

> diedral:=proc(n)
local L,i;
if n mod 2=0
then L:=[seq(tabletocycles([seq((i+j-1) mod n+1,i=1..n)]),j=1..n),seq([seq([(i+j-1) mod n+1,(n-i+j) mod n+1],i=1..n/2)],j=1..n/2),seq([seq([(i+j) mod n+1,(n-i+j) mod n+1],i=1..n/2-1),[j+1],[(n/2+j) mod n+1]],j=1..n/2)];
else L:=[seq(tabletocycles([seq((i+j-1) mod n+1,i=1..n)]),j=1..n),seq([seq([(i+j-1) mod n+1,(n-i+j) mod n+1],i=1..floor(n/2)),[(floor(n/2)+j) mod n+1]],j=1..n)];
end if;

return L;
end proc;

> diedral(5);

> diedral(6);

Enfin, la procédure polynome donne le polynôme indicateur de cycles d'un groupe de permutations.

> polynome:=proc(G)
local Z,n,i,j,c;
Z:=0;
n:=add(nops(G[1][l]),l=1..nops(G[1]));
for i from 1 to nops(G) do
        c:=[seq(0,l=1..n)];
        for j from 1 to nops(G[i]) do
                c[nops(G[i][j])]:=c[nops(G[i][j])]+1;
        end do;
        Z:=Z+mul((X[i])^(c[i]),i=1..n);
end do;
return Z/nops(G);
end proc;

Par exemple, le polynôme indicateur de cycles du groupe diedral D₁₂ est :

> polynome(diedral(6));

En substituant q à X₁,...,X₆, on obtient le nombre n(q) de colliers de 6 perles ayant au plus q couleurs. Pour avoir le nombre m(q) de colliers de 6 perles ayant exactement q couleurs, on fait la différence n(q)-n(q-1).

> n:=q->subs(seq(X[i]=q,i=1..6),polynome(diedral(6)));
m:=q->n(q)-n(q-1);

> n(3);n(4);m(4);

3. COLORIAGES

On programme ici une procédure qui donne une liste de tous les colliers de p perles à q couleurs. On commence par expliciter deux générateurs du groupe diedral : une rotation et une symétrie.

> rotation:=c->[seq(c[i+1],i=1..nops(c)-1),c[1]];

> reflexion:=c->[c[1],seq(c[nops(c)+1-i],i=1..ceil(nops(c)/2)),seq(c[floor(nops(c)/2)+1-i],i=1..floor(nops(c)/2)-1)];

La procédure modulotransformation teste si un coloriage est déjà dans une liste L modulo les rotations et les symétries.

> modulotransformation:=proc(c,L)
local m,n,i;
m:=c;n:=reflexion(c);
for i from 1 to nops(c) do
if m in L or n in L then return true; end if;
m:=rotation(m);n:=rotation(n);
end do;
return false;
end proc;

On a besoin du petit programme suivant qui prend en entrée un nombre et renvoie les chiffres des unités, des k-aines, des k²-aines, etc (par exemple, decomp(1234,10)=[1,2,3,4]).

> decomp:=proc(n,k)
local m,R;
R:=[];m:=n;
while m<>0 do
R:=[m-k*floor(m/k),op(R)];m:=floor(m/k);
end do;
return R;
end proc;

On peut maintenant écrire la procédure coloriage qui décrit tous les colliers de p perles dont les couleurs sont dans la liste C.

> coloriages:=proc(p,C)
local L,i,U;
L:=[];
for i from 0 to nops(C)^p-1 do
        U:=[op(decomp(i,nops(C),p)),seq(0,j=1..p)];
        if not(modulotransformation([seq(C[U[j]+1],j=1..p)],L))
        then L:=[op(L),[seq(C[U[j]+1],j=1..p)]];
        end if;
end do;
return L;
end proc;

On retrouve les résultats trouvés précédemment : il y a 92 (resp. 430) colliers de 6 perles ayant au plus 3 (resp. 4) couleurs. On en a maintenant une énumération explicite.

> nops(coloriages(6,[r,b,v]));nops(coloriages(6,[r,b,v,j]));