MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: How to do quickest


Without changing the basic operation of your algorithm I've changed a
couple of details. The difference is not huge, but about 20% of speed
gain is still nice.

pol = x^8 - x - 1;
 nn = Length[CoefficientList[pol, x]] - 1;
 If[IrreduciblePolynomialQ[pol],
  pp = IntegerPartitions[nn];
  aa = Table[{}, {n, 1, Length[pp]}]; Print[aa];
  ff = FactorInteger[Discriminant[pol, x]];
  bb = Table[ff[[n, 1]], {n, 1, Length[ff]}];
  n = 1;
  cn = 0;
  While[cn < nn!,
   p = Prime[n];
   If[MemberQ[bb, p],
    (*True*),
    cn++;
    kk = FactorList[pol, Modulus -> p];
    ww = Table[
      Length[CoefficientList[kk[[m, 1]], x]] - 1,
      {m, Length[kk], 2, -1}
      ];
    pos = Position[pp, ww, 1, 1][[1, 1]];
    aa[[pos]] = {aa[[pos]], p};
    ];
   n++
   ]
  ]; aa = Map[Flatten, aa, {1}];
 Table[Length[aa[[m]]], {m, 1, Length[aa]}]
 ]


Cheers -- Sjoerd


On Feb 15, 12:33 pm, Artur <gra... at csl.pl> wrote:
> 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



  • Prev by Date: n-adic integers
  • Next by Date: Interpolation difficulty
  • Previous by thread: Re: How to do quickest
  • Next by thread: Re: How to do quickest