Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: How do little quickest ?

• To: mathgroup at smc.vnet.net
• Subject: [mg93480] Re: [mg93475] How do little quickest ?
• From: DrMajorBob <btreat1 at austin.rr.com>
• Date: Tue, 11 Nov 2008 07:44:26 -0500 (EST)
• References: <gf3mj0$en2$1@smc.vnet.net> <200811091026.FAA20573@smc.vnet.net>
• Reply-to: drmajorbob at longhorns.com

This is still too slow for x=30, but it's faster than what you had:

Your code:

Timing[aa = {}; Do[rmin = 10^10; k = 2^x; w = Floor[(k - 1)/2];
   Do[If[GCD[n, k, k - n] == 1, m = FactorInteger[k n (k - n)];
     rad = 1;
     Do[rad = rad m[[s]][[1]], {s, 1, Length[m]}];
     If[rad < rmin, rmin = rad]], {n, 1, w}];
   AppendTo[aa, rmin], {x, 2, 19}]; aa]

{12.3087, {6, 14, 30, 30, 42, 30, 78, 182, 1110, 570, 1830, 6666,
   2310, 2534, 5538, 9870, 20010, 141270}}

My code:

Clear[artur]
primeProduct = Times @@ FactorInteger[#][[All, 1]] &;
artur[1] = {};
artur[x_Integer] /; x > 1 := artur[x] = Module[{k = 2^x, up, down},
    up = Range[1, k/2 - 1, 2]; down = k - up;
    Append[artur[x - 1],
     Min[2 (primeProduct /@ up) (primeProduct /@ down)]]
    ]
Timing[artur@19]

{3.53437, {6, 14, 30, 30, 42, 30, 78, 182, 1110, 570, 1830, 6666,
   2310, 2534, 5538, 9870, 20010, 141270}}

Performance is a little worse than exponential despite the use of dynamic  
programming (artur[x_] := artur[x] = ...), as you can see from the plot:

Clear[artur]
primeProduct = Times @@ FactorInteger[#][[All, 1]] &;
artur[1] = {};
artur[x_Integer] /; x > 1 := artur[x] = Module[{k = 2^x, up, down},
    up = Range[1, k/2 - 1, 2]; down = k - up;
    Append[artur[x - 1],
     Min[2 (primeProduct /@ up) (primeProduct /@ down)]]
    ]
times = Array[First@Timing[artur@#;] &, 21]
ListPlot[Log@times]

{6.*10^-6, 0.000106, 0.00006, 0.00008, 0.00011, 0.000188, 0.000338, \
0.000651, 0.001473, 0.002614, 0.005246, 0.010736, 0.022128, 0.045639, \
0.093031, 0.194126, 0.451856, 0.937878, 1.91669, 3.93122, 8.15931}

If we had a name for what you're trying to accomplish, we might do a lot  
better.

Bobby

On Mon, 10 Nov 2008 02:31:17 -0600, Artur <grafix at csl.pl> wrote:

> Dear Mathematica Gurus!
> Who know how do quickest following prcedure:
>
> aa = {}; Do[Print[x]; rmin = 10^10; k = 2^x; w = Floor[(k - 1)/2];
>  Do[If[GCD[n, k, k - n] == 1, m = FactorInteger[k n (k - n)]; rad = 1;
>     Do[rad = rad m[[s]][[1]], {s, 1, Length[m]}];
>    If[rad < rmin, rmin = rad]], {n, 1, w}];
>  AppendTo[aa, rmin], {x, 2, 30}]; aa
>
> Best wishes
> Artur
>



-- 
DrMajorBob at longhorns.com

• References:
  • Re: NIntegrate[UnitStep[...]PDF[...],{x,...}] hard to integrate
    • From: er <erwann.rogard@gmail.com>