Collatz Stopping Times

Math 242 Modern Computational Mathematics

Preliminary Code

We start with our Collatz function code from the past few class sessions. First, we define the Collatz function:

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

Next, we need our computeTrajectory module that computes the sequence of Collatz iterates from a starting integer n. This module stops when either a 1 is reached or the loop repeats maxIter times.

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
]

We also want our plotTrajectory function:

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

t=computeTrajectory[7]
plotTrajectory[t]

Length[t]

Stopping time of Collatz trajectories

For any positive integer n, define  stop(n) to be the number of iterations of the function col required to reach 1 from n. This is one less than the length of the list returned by our computeTrajectory function.

stop[n_]:=Length[computeTrajectory[n]]-1

Let’s compute some stopping times:

stop[5]

stop[7]

stopList=stop/@Range[40]

We could also use Tally to find some common stopping times:

Tally[stopList]

What would a plot of stopping times look like?

stopList=stop/@Range[2000];
ListPlot[stopList,AxesLabel->{"n","stop(n)"}]

What do you notice about the stopping time plot? What questions does this prompt you to ask?

We notice “horizontal segments” in the plot. Why do these appear?

ReverseSortBy[Tally[stopList],Last]

The most common stopping time in the list above is 29. What value of n have stopping time 29?

Position[stopList,29]//Flatten

Can we find two consecutive identical entries in a list?

Write a function findPair that takes a list an returns the location of the first two consecutive identical entries.

Here is one way to do it, using a Do loop:

findPair[vals_]:=Module[
{},
(* loop through the list, checking whether the entries at indexes i and i+1 are equal *)
Do[
If[vals[[i]]==vals[[i+1]],Return[i,Module]],
{i,1,Length[vals]-1}
];
(* if we get here, we didn't find a repeated value *)
False
]

Test the function:

findPair[{1,5,5,3}]

findPair[{1,2,3,4}]

findPair[stopList]

Here is another way to do it with a While loop:

findPair[vals_]:=Module[
{i=1},
While[i<Length[vals],
If[vals[[i]]==vals[[i+1]],Return[i]];
i+=1
];
(* if we get here, we didn't find a repeated value *)
False
]

Test the function:

findPair[{1,5,5,3}]

findPair[{1,2,3,4}]

findPair[stopList]

Detecting a streak in a list

Define a streak of length k to be k consecutive identical elements in a list.

Write a function that finds a streak of length k in a list. Here is one way to do it, similar to Algorithm 3.9 in the text:

detectStreak[vals_,k_]:=Module[
{currStreak=1,currPos=2},

(* main loop *)
While[currPos<Length[vals],
If[vals[[currPos]]==vals[[currPos-1]],currStreak=currStreak+1,currStreak=1];
If[currStreak==k,Break[]];
currPos=currPos+1
];

(* determine the return value *) 
If[currStreak==k,currPos-currStreak+1,False]
]

Confirm that this function works:

detectStreak[{4,1,7,2,2,2,4},3]

detectStreak[{1,2,3,4,4,5},3]

Here is another way to do it:

detectStreak[vals_,k_]:=Module[
{currStreak=1},

(* main loop *)
Do[
If[vals[[currPos]]==vals[[currPos-1]],currStreak=currStreak+1,currStreak=1];
If[currStreak==k,Return[currPos-k+1,Module]],
{currPos,2,Length[vals]}];

(* if we get here, then we didn't find a streak of length k *)
False
]

Confirm that this function works:

detectStreak[{4,1,7,2,2,2,4},3]

detectStreak[{1,2,3,4,4,5},3]

Now we can search for a streak of four consecutive identical stopping times:

detectStreak[stopList,4]

Confirm that the stopping times are the same for n from 98 to 102:

stop/@ Range[98,102]