[Date Index]
[Thread Index]
[Author Index]
Re: How to do quickest
*To*: mathgroup at smc.vnet.net
*Subject*: [mg123081] Re: How to do quickest
*From*: Andrzej Kozlowski <akoz at mimuw.edu.pl>
*Date*: Tue, 22 Nov 2011 07:23:51 -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>
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:
**Texture on Disk in Mathematica 8?**
Previous by thread:
**Re: How to do quickest**
Next by thread:
**Re: How to do quickest**
| |