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