> | 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 D2n 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 D12 est :
> | polynome(diedral(6)); |
En substituant q à X1,...,X6, 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 k2-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])); |