How to do quickest
- To: mathgroup at smc.vnet.net
- Subject: [mg116430] How to do quickest
- From: Artur <grafix at csl.pl>
- Date: Tue, 15 Feb 2011 06:33:12 -0500 (EST)
Dear Mathematica Gurus,
How to do following procedure quickest?
(*start*)
pol = x^8 - x - 1; nn = Length[CoefficientList[pol, x]] - 1; If[
IrreduciblePolynomialQ[pol], pp = IntegerPartitions[nn]; aa = {};
Do[AppendTo[aa, {}], {n, 1, Length[pp]}]; Print[aa];
ff = FactorInteger[Discriminant[pol, x]]; bb = {};
Do[AppendTo[bb, ff[[n]][[1]]], {n, 1, Length[ff]}]; n = 1; cn = 0;
While[cn < nn!, p = Prime[n];
If[MemberQ[bb, p], , cn = cn + 1;
kk = FactorList[pol, Modulus -> p]; ww = {};
Do[cc = Length[CoefficientList[kk[[m]][[1]], x]];
AppendTo[ww, cc - 1], {m, 2, Length[kk]}]; ww = Reverse[ww];
pos = Position[pp, ww][[1]][[1]]; AppendTo[aa[[pos]], Prime[n]]];
n++]]; Table[Length[aa[[m]]], {m, 1, Length[aa]}]
(*end*)
Best wishes
Artur