MathGroup Archive 2009

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

Search the Archive

Re: Re: Faster alternative to AppendTo?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg102967] Re: [mg102906] Re: [mg102886] Faster alternative to AppendTo?
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Thu, 3 Sep 2009 05:40:38 -0400 (EDT)
  • References: <200909010753.DAA18801@smc.vnet.net>
  • Reply-to: drmajorbob at yahoo.com

211.9884000 seconds is MORE than 3 minutes, but anyway...

I think this is a faster algorithm:

Clear[g, h]
g[1] = 1;
g[n_] := Which[
   ListQ@n, n,
   ListQ@h@n, Rest@h@n,
   EvenQ@n, n/2,
   True, 3 n + 1
   ]
AbsoluteTiming[
  Table[h[m] = Flatten@Most@FixedPointList[g, m], {m, 1, 1000000}];]

{54.366878, Null}

Bobby

On Wed, 02 Sep 2009 03:00:51 -0500, Tomas Garza <tgarza10 at msn.com> wrote:

> It seems to me you are wasting Mathematica in trying to replicate old  
> programming paradigms. Mathematica has a very powerful programming  
> language, functional programming, which is ideally suited to handle  
> problems like the one you have. So, for example, I obtain the answer for  
> 1,000,000 points in less than three minutes:
>
>
> In[1]:= AbsoluteTiming[Table[NestWhileList[g, m, #>1&],{m, 1, 1000000}];]
> Out[1]= {211.9884000,Null}
>
> Check the result for m = 10:
>
> In[2]:= Table[NestWhileList[g,m,#>1&],{m,1,10}]
>
> Out[2]=  
> {{1},{2,1},{3,10,5,16,8,4,2,1},{4,2,1},{5,16,8,4,2,1},{6,3,10,5,16,8,4,2,1},{7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1},{8,4,2,1},{9,28,14,7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1},{10,5,16,8,4,2,1}}
>
> You'll find it worthile spending a few hours studying this approach.
>
> Tomas
>
>> Date: Tue, 1 Sep 2009 03:53:33 -0400
>> From: dem_z at hotmail.com
>> Subject: [mg102886] Faster alternative to AppendTo?
>> To: mathgroup at smc.vnet.net
>>
>> Hey, sorry I'm really new. I only started using mathematica recently,  
>> so I'm not that savvy.
>>
>> Anyways, I wrote some code to calculate (and store) the orbits around  
>> numbers in the Collatz conjecture.
>>
>> "Take any whole number n greater than 0. If n is even, we halve it  
>> (n/2), else we do "triple plus one" and get 3n+1. The conjecture is  
>> that for all numbers this process converges to 1. "
>>  http://en.wikipedia.org/wiki/Collatz_conjecture
>>
>>
>> (*If there's no remainder, divides by 2, else multiply by 3 add 1*)
>> g[n_] := If[Mod[n, 2] == 0, n/2, 3 n + 1]
>>
>> (*creates an empty list a. Loops and appends the k's orbit into  
>> variable "orbit", which then appends to variable "a" after the While  
>> loop is completed.  New m, sets new k, which restarts the While loop  
>> again.*)
>> a = {};
>> Do[
>>   k = m;
>>   orbit = {k};
>>   While[k > 1, AppendTo[orbit, k = g[k]]];
>>   AppendTo[a, orbit];
>>   , {m, 2,1000000}];
>>
>> Anyways it seems that the AppendTo function gets exponentially slower,  
>> as you throw more data into it. Is there a way to make this more  
>> efficient? To calculate a million points takes days with this method.
>>
>
>



-- 
DrMajorBob at yahoo.com


  • Prev by Date: Re: Bug in Solve?
  • Next by Date: Re: Re: Faster alternative to AppendTo?
  • Previous by thread: Re: Re: Faster alternative to AppendTo? --
  • Next by thread: Re: Re: Faster alternative to AppendTo?