Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: How to do quickest

• To: mathgroup at smc.vnet.net
• Subject: [mg123056] Re: How to do quickest
• From: DrMajorBob <btreat1 at austin.rr.com>
• Date: Tue, 22 Nov 2011 05:33:43 -0500 (EST)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <201111210929.EAA14830@smc.vnet.net>
• Reply-to: drmajorbob at yahoo.com

A LITTLE better:

Clear[x, y]
kk = m /.
    First@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}];
Timing[qq =
   First@Last@
     Reap@Do[SquareFreeQ@x && (y = x^3 // Sqrt // Round;
         len = Length@CoefficientList[MinimalPolynomial[kk][z], z];
         len < 12) && Sow@{x, y, kk, len}, {x, 2, 3000}]]

{8.33515, {{1942, 85580, -3 Sqrt[2/5], 3}, {2878, 154396, -Sqrt[2],
    3}}}

Bobby

On Mon, 21 Nov 2011 16:35:40 -0600, DrMajorBob <btreat1 at austin.rr.com>  
wrote:

> Sorry, I had a couple of typos. Correct is:
>
> Clear[x, y]
> kk = m /.
>     First@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}];
> Timing[qq = First@Last@Reap@Do[y = x^3 // Sqrt // Round;
>        (x^3 - y^2) !=
>          0 &&
>         (len =
>            Length@CoefficientList[MinimalPolynomial[kk][z], z]) < 12 &&
>          Sow@{x, y, kk, len}, {x, 2, 3000}]]
>
> {13.5446, {{1942, 85580, -3 Sqrt[2/5], 3}, {2878, 154396, -Sqrt[2],
>     3}}}
>
> and
>
> Clear[x, y]
> kk = m /.
>     First@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}];
> Timing[qq =
>    First@Last@
>      Reap@Do[SquareFreeQ@x && (y = x^3 // Sqrt // Round; True) && (
>           len = Length@CoefficientList[MinimalPolynomial[kk][z], z]) <
>          12 && Sow@{x, y, kk, len}, {x, 2, 3000}]]
>
> {8.47326, {{1942, 85580, -3 Sqrt[2/5], 3}, {2878, 154396, -Sqrt[2],
>     3}}}
>
> Bobby
>
> On Mon, 21 Nov 2011 16:28:08 -0600, DrMajorBob <btreat1 at austin.rr.com>  
> wrote:
>
>> Here's your code timed with an upper limit of 3000:
>>
>> Timing[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, 3000}]]
>>
>> {971/1377495072,3 Sqrt[2/5],1942,85580,52488}
>>
>> {3 Sqrt[2/5],1942,85580}
>>
>> {1439/117596448,Sqrt[2],2878,154396,15336}
>>
>> {Sqrt[2],2878,154396}
>>
>> {187.257, Null}
>>
>> This is better:
>>
>> Clear[x, y]
>> kk = m /.
>>     First@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}];
>> Timing[qq = First@Last@Reap@Do[y = x^3 // Sqrt // Round;
>>        (x^3 - y^2) != 0 &&
>>
>>         Length@CoefficientList[MinimalPolynomial[kk][z], z] < 12 &&
>>         Sow@{x, y, kk, len}, {x, 2, 3000}]]
>>
>> {14.0493, {{1942, 85580, -3 Sqrt[2/5], 13}, {2878, 154396, -Sqrt[2],
>>     13}}}
>>
>> And this, even better:
>>
>> Clear[x, y]
>> kk = m /.
>>     First@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}];
>> Timing[qq =
>>    First@Last@
>>      Reap@Do[SquareFreeQ@x && (y = x^3 // Sqrt // Round; True) &&
>>
>>           Length@CoefficientList[MinimalPolynomial[kk][z], z] < 12 &&
>>         Sow@{x, y, kk, len}, {x, 2, 3000}]]
>>
>> {8.39548, {{1942, 85580, -3 Sqrt[2/5], 13}, {2878, 154396, -Sqrt[2],
>>     13}}}
>>
>> All this is VERY slow nonetheless. Maybe there's another way to  
>> characterize the problem?
>>
>> Bobby
>>
>> On Mon, 21 Nov 2011 03:29:38 -0600, Artur <grafix at csl.pl> 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*)
>>>
>>
>>
>
>


-- 
DrMajorBob at yahoo.com

• References:
  • How to do quickest
    • From: Artur <grafix@csl.pl>