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

MathGroup Archive 2011

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

Search the Archive

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


  • Prev by Date: Replace elements in a matrix
  • Next by Date: Re: Using Mathematica for text mining
  • Previous by thread: Re: Replace elements in a matrix
  • Next by thread: Re: How to do quickest