Re: How to do quickest

*To*: mathgroup at smc.vnet.net*Subject*: [mg123053] Re: How to do quickest*From*: Daniel Lichtblau <danl at wolfram.com>*Date*: Tue, 22 Nov 2011 05:33:08 -0500 (EST)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com

----- Original Message ----- > From: "Artur" <grafix at csl.pl> > To: mathgroup at smc.vnet.net > Sent: Monday, November 21, 2011 3:29:38 AM > Subject: How to do quickest > > Dear Mathematica Gurus, > How to do quickest following procedure (which is very slowly): > > qq = {}; Do[y = Round[Sqrt[x^3]]; > If[(x^3 - y^2) != 0, > kk = m /. Solve[{4 m^2 + 6 m n + n^2 == > x, (19 m^2 + 9 m n + n^2) Sqrt[m^2 + n^2] == y}, {m, > n}][[1]]; > ll = CoefficientList[MinimalPolynomial[kk][[1]], #1]; > lll = Length[ll]; > If[lll < 12, Print[{x/(x^3 - y^2)^2, kk, x, y, x^3 - y^2}]; > If[Length[ll] == 3, Print[{kk, x, y}]]]], {x, 2, 1000000}]; > qq > > > (*Best wishes Artur*) This is somewhat faster, rootpoly = m /. First[ Solve[{4 m^2 + 6 m n + n^2 - xx, (19 m^2 + 9 m n + n^2)^2 (m^2 + n^2) - yy^2} == 0, {m, n}]] -Sqrt[Root[ xx^6 - 2*xx^3*yy^2 + yy^4 + (270*xx^3 - 270*yy^2)*#1^3 - 2916*xx*#1^5 + 3645*#1^6 & , 1]] I only had patience to go to 10^3. nn = 3; Clear[x, y, kk, lll] Timing[Do[ If[! IntegerQ[Sqrt[x]], y = Round[Sqrt[x^3]]; kk = rootpoly /. {xx -> x, yy -> y}; lll = Exponent[MinimalPolynomial[kk][[1]], #1]; If[lll < 12, Print[{lll, x/(x^3 - y^2)^2, kk, x, y, x^3 - y^2}]]; ], {x, 2, 10^nn}];] Faster still would be to figure out a priori conditions for which rootpoly is of degree less than 12. Then just test {x,y} pairs to see which ones qualify. Other possibilities for this might include working with Resultant[ 4 m^2 + 6 m n + n^2 - x, (19 m^2 + 9 m n + n^2)^2 (m^2 + n^2) - y^2, n] Out[9]= 3645*m^12 - 2916*m^10*x + 270*m^6*x^3 + x^6 - 270*m^6*y^2 - 2*x^3*y^2 + y^4 Specifically one wants to know for which {x,y} pairs in the loop this will factor. Daniel Lichtblau Wolfram Research