Re: How to do quickest
- To: mathgroup at smc.vnet.net
- Subject: [mg123126] Re: How to do quickest
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Thu, 24 Nov 2011 06:55:28 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <201111210929.EAA14830@smc.vnet.net>
- Reply-to: drmajorbob at yahoo.com
I'm getting all these REPEATED, 2 days after the first round. Great. Bobby On Wed, 23 Nov 2011 06:05:09 -0600, Andrzej Kozlowski <akoz at mimuw.edu.pl> wrote: > 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 >>> >>> >>> >>> > > -- DrMajorBob at yahoo.com
- References:
- How to do quickest
- From: Artur <grafix@csl.pl>
- How to do quickest