Re: How to do quickest
- To: mathgroup at smc.vnet.net
- Subject: [mg123089] Re: How to do quickest
- From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
- Date: Wed, 23 Nov 2011 07:05:09 -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> <sig.13073ac2f6.4ECBD594.7060709@csl.pl>
My memory of Eisenstein's criterion was wrong (also, I was too much in a
hurry to look it up). Rather than correcting it I got rid of it
altogether since I think Mathematica probably uses it anyway. I then
get:
In[1]:= 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[1]= 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[2]:= Block[{y = Round[Sqrt[x^3]]},
Reap[Table[
If[x^3 - y^2 != 0 && Not[IrreduciblePolynomialQ[poly]],
Sow[{x, y}]], {x, 2, 1000000}]][[2]]] // Timing
Out[2]= {1089.54,({1942,85580} {2878,154396} {3862,240004}
{6100,476425} {8380,767125} {11512,1235168} {15448,1920032}
{18694,2555956} {31228,5518439} {93844,28748141}
{111382,37172564} {117118,40080716} {129910,46823500}
{143950,54615700} {186145,80311375} {210025,96251275}
{375376,229985128} {445528,297380512} {468472,320645728}
{575800,436925600} {844596,776199807} {950026,925983476}
)}
This gets all the numbers but is much slower (I guess it will be better
to add the Eisenstein criterion after all, but of course, in correct
form).
Andrzej Kozlowski
On 22 Nov 2011, at 18:02, Artur wrote:
> Dear Andrzej,
> Your procedure omiited some points
> 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}][[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*)
>>>>>
>>>>>
>>>> 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[31]:= Block[{y = Round[Sqrt[x^3]]},
>>>> Reap[Table[
>>>> If[(x^3 - y^2) != 0 && Not[IrreduciblePolynomialQ[poly]],
>>>> Sow[{x, y}]], {x, 2, 1000000}]][[2]]] // Timing
>>>>
>>>> Out[31]= {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}]][[2]]]
>>>>
>>>> {}
>>>>
>>>> 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[1]:=
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[1]= 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[2]:=
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}]][[2]]]//Timing
>>
>> Out[2]= {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}][[1]]
>>
>> Out[12]= -Sqrt[-(198/5)-(44 I Sqrt[11])/5]
>>
>> ll = CoefficientList[MinimalPolynomial[kk][[1]], #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
>>
>>
>>
>>
- References:
- How to do quickest
- From: Artur <grafix@csl.pl>
- Re: How to do quickest
- From: Andrzej Kozlowski <akoz@mimuw.edu.pl>
- How to do quickest