Collatz Heights

Math 242 Modern Computational Mathematics

Preliminary Code

The Collatz Function

Last time we defined the Collatz function Col(n) for any positive integer n as follows: if n is even, then Col(n)=(n/2), but if n is odd, then Col(n)=3n+1.

col[n_?OddQ]:=3n+1
col[n_?EvenQ]:=n/2

Computing trajectories

We also wrote a computeTrajectory module that computes the sequence of Collatz iterates from a starting integer n.

Today we modify our computeTrajectory module, specifying an optional parameter maxIter with a default value of 100,000. Note the syntax for this modification. If the length of the trajectory reaches maxIter, the Break statement ends the loop. This is a safeguard to prevent the loop for running for an extremely long time.

computeTrajectory[start_,maxIter_:100000]:=Module[
{n=start,traj={start}},
(* compute the trajectory until we find 1 *)
While[n!=1,
n=col[n];
AppendTo[traj,n];
If[Length[traj]==maxIter,Break[]] (* quit if the length of the trajectory reaches maxIter *)
];
(* return the trajectory *)
traj
]

Test our revised module:

computeTrajectory[27]

Length[%]

Plotting trajectories

Here is an improved version of our plotTrajectory function from last time.

plotTrajectory[trajectory_]:=ListPlot[trajectory,PlotRange->All,AxesLabel->{"iteration","value"},Joined->True,PlotStyle->Orange,Mesh->All,MeshStyle->{Blue,PointSize[Medium]}]

We can compute a trajectory and then plot it like this:

traj=computeTrajectory[27]
plotTrajectory[traj]

Heights of Collatz Trajectories

Today we will explore the heights of Collatz trajectories. Let height(n) denote the maximum value in the Collatz trajectory starting with n.

Let’s write a simple function that computes the height of a Collatz trajectory:

Max[{3,8,2,12,-5}]

height[n_]:=Max[computeTrajectory[n]]

Try it out:

height[27]

computeTrajectory[7]

height[7]

heightList=Table[height[n],{n,1,20}]

heightList=height/@Range[20]

Height 16 appears frequently. Which starting value lead to height 16?

list16=Position[heightList,16]//Flatten

computeTrajectory/@list16

What is the most common height for starting values n<=100?

heightList=height/@Range[100]

Tally[heightList]

ReverseSortBy[Tally[heightList],Last]

FactorInteger[9232]

(2^4)*577

What is the most common height for starting values n<=10000?

ReverseSortBy[Tally[height/@Range[10000]],Last]

Visualizing heights

What happens if we plot height(n) for lots of positive integers n?

heightList=height/@Range[10000];
heightPlot=ListPlot[heightList,AxesLabel->{"starting value n","height(n)"},PlotHighlighting->None]

If plots with lots of points cause Mathematica to crash, try adding the PlotHighlighting→None option, as above. This seems to allow Mathematica to more easily create large plots.

Here is a plot of the lines n and 3n+1.

linePlot=Plot[{n,3n+1},{n,1,10000},PlotStyle->{{Orange,Thickness[0.01]},{Green,,Thickness[0.01]}},PlotHighlighting->None]

Use Show to display two plots simultaneously.

Show[linePlot,heightPlot]

Do you see horizontal lines in the height plot? At what height values do these lines appear?

Do you notice some diagonal lines in the height plot above? How can you explain these?

Fix some large positive integer N. What proportion of positive integers n<N satisfy height(n)=n? Is this proportion stable as N increases?

Here is one way to go about this. We will first compute a height list. Then we will compute a table whose nth entry is 1 if height(n)=n and 0 otherwise. Adding up the first N values of this table counts the number of starting values n < N such that height(n)=n; we will convert these counts to proportions and store them in another list.

heightList=height/@Range[10000];
nList=Table[If[heightList[[n]]==n,1,0],{n,1,Length[heightList]}];
proportions=Table[Total[nList[[;;n]]]/n,{n,1,Length[heightList]}];

Now plot the proportions of starting values n < N such that height(n)=n

ListPlot[proportions,AxesLabel->{"N","proportion of height(n)=n for n <= N"},PlotRange->{0.1,0.2},PlotHighlighting->None]

The proportion starts off near 20% but drops to about 10% when N≈9000.

Let’s look at larger ranges of values of N:

heightList=height/@Range[100000];
nList=Table[If[heightList[[n]]==n,1,0],{n,1,Length[heightList]}];
proportions=Table[Total[nList[[;;n]]]/n,{n,1,Length[heightList]}];

ListPlot[proportions,AxesLabel->{"N","proportion of height(n)=n for n <= N"},PlotHighlighting->None]

Fascinating! The proportion appears to climb back up to about 14%.

Let's compute this proportion up to N=1000000

heightList=height/@Range[1000000];
nList=Table[If[heightList[[n]]==n,1,0],{n,1,Length[heightList]}];
proportions=Total[nList]/Length[nList]//N

The percentage of Collatz trajectories with starting values n<1000000 such that height(n)=n is about 14.3%. I wonder if this is approximately the limiting value of this proportion as N->∞?

Fix some large positive integer N. What proportion of values n<=N satisfy height(n)=3n+1? Is this proportion stable as N increases?

What is the smallest height that occurs for more than 1579 different starting values?

Write at least two good mathematical questions about the heights of Collatz sequences.

As we stated last time, a good mathematical question satisfies the following four characteristics:

The question is interesting to you.

It is not an question whose answer you already know.

It is not a question you've seen before, or at least not exactly.

It is a question about which you can begin to make computational investigations.

(These characteristics are from Barry Mazur and William Stein in Prime Numbers and the Riemann Hypothesis.)