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

MathGroup Archive 2011

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

Search the Archive

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
>>
>>
>>
>>




  • Prev by Date: Re: How to do quickest
  • Next by Date: Re: What is the point of having Initializations in DynamicModule and Manipulate?
  • Previous by thread: Re: How to do quickest
  • Next by thread: Re: How to do quickest