Heights of Collatz Trajectories

Math 242 Modern Computational Mathematics

Preliminary Code

Here is our basic code for defining the Collatz function and computing trajectories.

col[n_?OddQ]:=3n+1
col[n_?EvenQ]:=n/2
computeTrajectory[start_,maxIter_:100000]:=Module[{traj={start},n=start},
(* compute the trajectory until we find 1 *)
While[n!=1&&Length[traj]<maxIter,
n=col[n];
AppendTo[traj,n];
];
(* return the trajectory *)
traj
]

computeTrajectory[27]

Stopping time of Collatz trajectories

Recall from the text that stop(n) is the number of iterations of the function col required to reach 1 from n.

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

stop[5]

computeTrajectory[5]

stop[27]

stopList=stop/@Range[50]

Position[stopList,18]

computeTrajectory/@{28,29,30}

ListPlot[stopList,AxesLabel->{"n","stop(n)"},PlotRange->All]

stopList=stop/@Range[1000]

ListPlot[stopList,AxesLabel->{"n","stop(n)"},PlotRange->All]

Let's find consecutive starting values with the same stopping time.

Definition: a streak is a set of consecutive identical values a list

Function to look for a streak of a desired length in a list:

detectStreak[list_, desiredLen_]:=Module[{pos=2,currStreak=1},

(* loop over list elements *)
While[currStreak<desiredLen&&pos<=Length[list],
If[list[[pos]]==list[[pos-1]],currStreak+=1,currStreak=1];
pos+=1
];

(* return value *)
If[currStreak==desiredLen,pos-currStreak,False]
]

Try it out:

detectStreak[{5,3,1,3,3,7,7,7,9,2},2]

detectStreak[{5,3,1,3,3,7,7,7,9,2},3]

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

detectStreak[{5,5,5,3,1,3,3,7,7,7,9,2},3]

detectStreak[{5,3,1,3,3,7,7,9,2,2,2},3]

Is there a streak of 5 stopping times that are the same?

detectStreak[stopList,5]

stop/@Range[98,102]

computeTrajectory/@Range[98,102]