MathGroup Archive 2009

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

Search the Archive

Re: Faster alternative to AppendTo?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg102930] Re: Faster alternative to AppendTo?
  • From: pfalloon <pfalloon at gmail.com>
  • Date: Wed, 2 Sep 2009 04:05:09 -0400 (EDT)
  • References: <h7ijtl$ibb$1@smc.vnet.net>

On Sep 1, 5:53 pm, Dem_z <de... at hotmail.com> wrote:
> 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.

Yes, AppendTo doesn't work very well at all for this kind of thing,
because the process of growing the list dynamically is very
inefficient (see the documentation for more details). A more efficient
alternative in general when you don't know how long the list will be
is to use the functions Reap and Sow.

However, for this problem there are better solutions which make use of
some Mathematica-esque programming style (there many more, perhaps
much nicer than these...).

1. You can set it up as "fixed-point" type of process, whereby it
keeps iterating until it reaches 1:

collatzOrbit[n_Integer] := FixedPointList[Which[#===1, 1, EvenQ[#], #/
2, True, 3#+1]&, n, 1000]

This is pretty efficient, but it has no "memory", in the sense that it
forgets values that it has previously encountered.

2. A way to save previous results is to use "dynamic programming" to
save the values computed recursively. Here I define a function to
calculate the number of steps in the orbit:

Clear[collatzOrbitLength];
collatzOrbitLength[1] = 1;
collatzOrbitLength[n_Integer] := collatzOrbitLength[n] = 1 +
collatzOrbitLength[If[EvenQ[n], n/2, 3n+1]]

You should look up the documentation and possibly other sources online
to understand how this works.

Using this definition I am able to compute the orbit lengths up to
n=10^6 in about 22 seconds on a reasonably fast Windows machine
(though there is a technical subtlety: you need to temporarily
increase the value of $RecursionLimit or else an automatic error-check
will kick in):

Block[{$RecursionLimit=10000}, pts = collatzOrbitLength /@ Range
[1000000]]; // Timing

{21.86, Null}

The maximum number of steps in this range is:

{Max[pts], Flatten@Position[pts, Max[pts]]}

One downside to this approach is that it starts to consume a lot of
memory as you compute more values. However, you can easily Clear the
stored definitions.

Hope this helps and happy programming!

Cheers,
Peter.


  • Prev by Date: Re: Question about SDTS format
  • Next by Date: Re: Two Questions
  • Previous by thread: Re: Faster alternative to AppendTo?
  • Next by thread: Re: Can't reproduce a solution found in a paper using Mathematica