       Re: How to do quickest

• To: mathgroup at smc.vnet.net
• Subject: [mg123087] Re: How to do quickest
• From: Artur <grafix at csl.pl>
• Date: Wed, 23 Nov 2011 07:04:46 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <201111210929.EAA14830@smc.vnet.net> <8FECCEBE-CBFE-4B7C-87A5-4856C65C2DB4@mimuw.edu.pl> <7F85110E-2F9F-4B87-8F98-C7EEF63DEB4D@mimuw.edu.pl> <201111221223.HAA00196@smc.vnet.net>

```Dear Andrzej,
6100
8380

Best wishes
Artur

W dniu 2011-11-22 13:23, Andrzej Kozlowski pisze:
> On 22 Nov 2011, at 10:07, Andrzej Kozlowski wrote:
>
>> On 22 Nov 2011, at 10:06, Andrzej Kozlowski wrote:
>>
>>> On 21 Nov 2011, at 10:29, Artur wrote:
>>>
>>>> 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}][];
>>>> ll = CoefficientList[MinimalPolynomial[kk][], #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*)
>>>>
>>> I think it would be better to send not only the code but also the mathematical problem, as there may be a way to do it in a different way. Unless I am misunderstanding something, what you are trying to do is the same as this:
>>>
>>> In:= Block[{y = Round[Sqrt[x^3]]},
>>> Reap[Table[
>>>    If[(x^3 - y^2) != 0&&  Not[IrreduciblePolynomialQ[poly]],
>>>     Sow[{x, y}]], {x, 2, 1000000}]][]] // Timing
>>>
>>> Out= {721.327,{}}
>>>
>>> This ought to be a lot faster than your code, but I have not tried to run yours to the end. Also, it is possible that using the Eisenstein Test explicitly may be somewhat faster:
>>>
>>> Block[{y = Round[Sqrt[x^3]]},
>>> Reap[Table[
>>>   If[x^3 - y^2 != 0&&  Mod[x^6 - 2*x^3*y^2 + y^4, 4] == 0&&
>>>             ! IrreduciblePolynomialQ[poly], Sow[{x, y}]], {x, 2,
>>>    1000000}]][]]
>>>
>>> {}
>>>
>>> but I forgot to use Timing and don't want to wait again, particularly that the answer is the empty set.
>>>
>>> Andrzej Kozlowski
>> I forgot to include the definition of poly:
>>
>> Collect[poly = Eliminate[{4*m^2 + 6*m*n + n^2 == x,
>>      (19*m^2 + 9*m*n + n^2)*Sqrt[m^2 + n^2] == y}, {n}] /. Equal ->  Subtract, m]
>>
>> 3645*m^12 - 2916*m^10*x + m^6*(270*x^3 - 270*y^2) + x^6 -
>> 2*x^3*y^2 + y^4
>>
>> Andrzej Kozlowski
>
> Strange but I run this code with a fresh kernel and got the following answers:
>
> In:= Collect[poly=Eliminate[{4*m^2+6*m*n+n^2==x,(19*m^2+9*m*n+n^2)*Sqrt[m^2+n^2]==y},{n}]/.Equal->Subtract,m]
> Out= 3645 m^12-2916 m^10 x+m^6 (270 x^3-270 y^2)+x^6-2 x^3 y^2+y^4
>
> In:= Block[{y=Round[Sqrt[x^3]]},Reap[Table[If[x^3-y^2!=0&&Mod[x^6-2*x^3*y^2+y^4,4]==0&&!IrreduciblePolynomialQ[poly],Sow[{x,y}]],{x,2,1000000}]][]]//Timing
>
> Out= {766.05,({1942,85580}	{2878,154396}	{3862,240004}	{11512,1235168}	{15448,1920032}	{18694,2555956}	{111382,37172564}	{117118,40080716}	{129910,46823500}	{143950,54615700}	{186145,80311375}	{210025,96251275}	{375376,229985128}	{445528,297380512}	{468472,320645728}	{575800,436925600}	{950026,925983476}
>
> )}
>
>
> I tested the first one and it does seem to be a solution to your problem.
>
> {x, y} = {950026, 925983476};
>
> y == Round[Sqrt[x^3]]
>
> True
>
> x^3 - y^2 != 0
>
> True
>
> 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}][]
>
> Out= -Sqrt[-(198/5)-(44 I Sqrt)/5]
>
> ll = CoefficientList[MinimalPolynomial[kk][], #1];
>
> Length[ll]
>
> 5
>
> I don't know why I got no answers the first time round, perhaps one of the variables had values assigned.
>
> Andrzej
>
>
>

```

• Prev by Date: Re: How to do quickest
• Next by Date: Re: How to do quickest
• Previous by thread: Re: How to do quickest
• Next by thread: Re: How to do quickest