Clear[canonsIrreg, irregulQ];
irregulQ[poly_] := Not[Module[
{l=Length[poly]},
Or[l==2,
Length[Expand[(poly[[2]]-1)*poly]]==2 ]
] ]
tousLesCoeff[poly_, var_:X] :=
Union[CoefficientList[poly, var]]
canonsIrreg[n_Integer] :=
If[Not[PrimeQ[n]],
(* rien à dire, rien à faire si n est premier *)
Module[{facteurs, nbreFacteurs,fact1, fact2,
soluces, chiffresBinaires, chiffres},
(* variables locales *)
soluces = {};
facteurs = First[Transpose[
Drop[FactorList[X^n-1],2]]];
(* liste des facteurs irréduc., sauf 1 et X-1 *)
nbreFacteurs = Length[facteurs];
Do[
chiffresBinaires = IntegerDigits[k, 2, nbreFacteurs];
chiffres = First /@ Position[chiffresBinaires, 1];
fact1 = Expand[Apply[Times,
Map[facteurs[[#]]&, chiffres]
] ];
If[tousLesCoeff[fact1]=={0,1},
(* si le premier facteur est un polynôme 0-1 *)
If[And[irregulQ[fact1],
tousLesCoeff[
fact2 = Cancel[(X^n-1)/(X-1)/fact1]
]=={0,1},
irregulQ[fact2]
], (* fin du And *)
AppendTo[soluces, {fact1,fact2}]
]
], (* fin du If *)
{k,2^(nbreFacteurs-1)} ]; (* fin du Do *)
soluces ] (* fin du Module *)
] (* fin du premier If *)
canonsIrreg[81]
Map[canonPlot, %];
Clear[ca54];
ca54=canonsIrreg[54]
canonPlot /@ ca54; canonPlot /@ (Reverse /@ ca54);