Physics 374
Fall 2005
Prof. E. F. Redish

MP 45 Solution

     Looking at the Non-Linear Logistic Difference Equation:
     					(Subscript[x, n + 1]) = r (Subscript[x, n])(1-(Subscript[x, n]))
we note that we should be able to use Euler-type Mathematica techniques to generate a table of values of x for successive n values.  There are many ways to go about doing this, but the following seems a good mix of clarity and efficiency.  First we'll set up a table with 100 entries, all of them set to the default initial value of .4.  Since we'll need to regenerate this starting table for each run, I've defined a function to do this.

tom[x_] := xdata = Table[x, {j, 1, 100, 1}];

Then we'll need a For loop to calculate the (n+1)-th entry based on the n-th entry via the rule given in the Non-Linear Logistic Difference Equation.  Since we'll have to call this For loop for many different values of r, I've written this as a function as well.

bing[r_] := 
        For[j = 1, j ≤ Length[xdata] - 1, j = j + 1, 
          xdata[[j + 1]] = 
            r*xdata[[j]]*(1 - xdata[[j]])];

And then simply typing "xdata" without a semicolon after it will display the 100 calculated values for us to inspect.  I haven't actually plotted the x values here since just looking at the 6-decimal-digit representations will turn out to be more informative.  
       Let's look at r = .5 first:

tom[ .4];

bing[ .5];

xdata

Obviously the x values go to zero as time wears on.  The population tends toward extinction.  Next we'll look at the r = 1.5 case.

tom[ .4];

bing[1.5];

xdata

Apparently the population fraction settles on one third for r = 1.5.  For r = 2.7:

tom[ .4];

bing[2.7];

xdata

Here the population fraction tends towards a constant .62963 (within rounding).  Since the growth rate is larger than in the previous case, it's comforting that we see a larger equilibrium population fraction.  Now look at r = 3.1:

tom[ .4];

bing[3.1];

xdata

Look what's happened by the time the values settle down in the second half of the table.  The predicted population fraction is alternating between two distinct values.  Successive cycles bring you back to the same x value to within, at most, one millionth.  Very strange.  Increasing r further to 3.5 gives:

tom[ .4];

bing[3.5];

xdata

We've had a splitting of the splitting.  Now the x values settle into a set of four repeating values, to incredible precision.  Finding the next "period doubling" is a little tricky...we'll probably need to include more than just the first 100 terms in order to give things enough time to settle down, so I'll modify my functions just a bit.

tom[x_] := xdata = Table[x, {j, 1, 300, 1}];

bing[r_] := 
        For[j = 1, j ≤ Length[xdata] - 1, j = j + 1, 
          xdata[[j + 1]] = 
            r*xdata[[j]]*(1 - xdata[[j]])];

After a little trial and error, the value r = 3.55 turns out to be promising:

tom[ .4];

bing[3.55];

xdata

And there you have it...an eight-fold repeating pattern out to the one-millionth decimal place.  However, for a slightly larger growth rate of r = 3.6:

tom[ .4];

bing[3.6];

xdata

Now there is no predictible pattern to the output.  Apparently the period has doubled without bound and we are now in the chaotic region.  That such complex behavior should come from the simple-looking Non-Linear Logistic Difference Equation is absolutely amazing.

(Solution by T .  Bing)