Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

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

Search the Archive

Re: How to do quickest

  • To: mathgroup at smc.vnet.net
  • Subject: [mg116541] Re: How to do quickest
  • From: "Sjoerd C. de Vries" <sjoerd.c.devries at gmail.com>
  • Date: Sat, 19 Feb 2011 05:12:14 -0500 (EST)
  • References: <ijdo9g$f8a$1@smc.vnet.net>

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