Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: How to do quickest

• To: mathgroup at smc.vnet.net
• Subject: [mg123065] Re: How to do quickest
• From: Artur <grafix at csl.pl>
• Date: Tue, 22 Nov 2011 05:35:27 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <febdfdb5-c1cc-472c-afd6-e1768e8723e1@wrimail02.wolfram.com>
• Reply-to: grafix at csl.pl

Dear Daniel and Rest,
Thank Your very much for improove my procedure!
m have simplest form but can be + or - n is little bit more complicated 
but have only one sign
Generally because I don't find another cases as m is root of quadratic 
polynopmial or 12 degree polynomial when non zero coefficient occured in 
even powers of variable (that mean is square root of 6 degree polynomial 
root) but for me aren't interesting this last cases we can uses 
IntegerQ[m^2]

Best wishes
Artur


W dniu 2011-11-21 23:18, Daniel Lichtblau pisze:
> ----- 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
>
>

• Follow-Ups:
  • Re: How to do quickest
    • From: Artur <grafix@csl.pl>