{k=3, r=1}

In[]:=
3^3^3
Out[]=
7625597484987

{k=2, r=2}

In[]:=
2^2^5
Out[]=
4294967296

{k=2, r=3/2}

In[]:=
2^2^4
Out[]=
65536

{k=3, r=3/2}

In[]:=
3^3^4
Out[]=
443426488243037769948249630619149892803

k=2, r=1

In[]:=
Table[n->FirstPosition[Total/@CellularAutomaton[n,{{1},0},{20,All}],0],{n,0,255,2}]
Out[]=
{0{2},2Missing[NotFound],4Missing[NotFound],6Missing[NotFound],8{2},10Missing[NotFound],12Missing[NotFound],14Missing[NotFound],16Missing[NotFound],18Missing[NotFound],20Missing[NotFound],22Missing[NotFound],24Missing[NotFound],26Missing[NotFound],28Missing[NotFound],30Missing[NotFound],32{2},34Missing[NotFound],36Missing[NotFound],38Missing[NotFound],40{2},42Missing[NotFound],44Missing[NotFound],46Missing[NotFound],48Missing[NotFound],50Missing[NotFound],52Missing[NotFound],54Missing[NotFound],56Missing[NotFound],58Missing[NotFound],60Missing[NotFound],62Missing[NotFound],64{2},66Missing[NotFound],68Missing[NotFound],70Missing[NotFound],72{2},74Missing[NotFound],76Missing[NotFound],78Missing[NotFound],80Missing[NotFound],82Missing[NotFound],84Missing[NotFound],86Missing[NotFound],88Missing[NotFound],90Missing[NotFound],92Missing[NotFound],94Missing[NotFound],96{2},98Missing[NotFound],100Missing[NotFound],102Missing[NotFound],104{2},106Missing[NotFound],108Missing[NotFound],110Missing[NotFound],112Missing[NotFound],114Missing[NotFound],116Missing[NotFound],118Missing[NotFound],120Missing[NotFound],122Missing[NotFound],124Missing[NotFound],126Missing[NotFound],128{2},130Missing[NotFound],132Missing[NotFound],134Missing[NotFound],136{2},138Missing[NotFound],140Missing[NotFound],142Missing[NotFound],144Missing[NotFound],146Missing[NotFound],148Missing[NotFound],150Missing[NotFound],152Missing[NotFound],154Missing[NotFound],156Missing[NotFound],158Missing[NotFound],160{2},162Missing[NotFound],164Missing[NotFound],166Missing[NotFound],168{2},170Missing[NotFound],172Missing[NotFound],174Missing[NotFound],176Missing[NotFound],178Missing[NotFound],180Missing[NotFound],182Missing[NotFound],184Missing[NotFound],186Missing[NotFound],188Missing[NotFound],190Missing[NotFound],192{2},194Missing[NotFound],196Missing[NotFound],198Missing[NotFound],200{2},202Missing[NotFound],204Missing[NotFound],206Missing[NotFound],208Missing[NotFound],210Missing[NotFound],212Missing[NotFound],214Missing[NotFound],216Missing[NotFound],218Missing[NotFound],220Missing[NotFound],222Missing[NotFound],224{2},226Missing[NotFound],228Missing[NotFound],230Missing[NotFound],232{2},234Missing[NotFound],236Missing[NotFound],238Missing[NotFound],240Missing[NotFound],242Missing[NotFound],244Missing[NotFound],246Missing[NotFound],248Missing[NotFound],250Missing[NotFound],252Missing[NotFound],254Missing[NotFound]}
In[]:=
Table[If[MissingQ[#[[2]]],Nothing,#]&[n->FirstPosition[Total/@CellularAutomaton[n,{{1},0},{20,All}],0]],{n,0,255,2}]
Out[]=
{0{2},8{2},32{2},40{2},64{2},72{2},96{2},104{2},128{2},136{2},160{2},168{2},192{2},200{2},224{2},232{2}}

k=2, r=3/2

In[]:=
2^2^4
Out[]=
65536
In[]:=
ParallelTable[If[MissingQ[#[[2]]],Nothing,#]&[n->FirstPosition[Total/@CellularAutomaton[{n,2,3/2},{{1},0},{20,All}],0]],{n,0,2^2^4-1,2}]
In[]:=
ReverseSortBy[%,Last]
In[]:=
CountsBy[%22,Last]
Out[]=
{3}256,{2}2048
In[]:=
Select[%22,#[[2]]=={3}&]
Out[]=
In[]:=
First/@Take[%22,10]
Out[]=
{61108,61076,60980,60948,60596,60564,60468,60436,60084,60052}
In[]:=
ArrayPlot[CellularAutomaton[{#,2,3/2},{{1},0},{5,All}],Mesh->True]&/@{20,52}
Out[]=

,

These are r=3/2 rules, so they should shown as bricks.... otherwise they’re asymmetric.
In[]:=
RulePlot[CellularAutomaton[{20,2,3/2}],{{1},0},5,Appearance->"Bricks",Mesh->True]
Out[]=

k=2, r=2

In[]:=
ParallelTable[SeedRandom[8869i],{i,200}];
In[]:=
Take[ReverseSortBy[ParallelTable[If[MissingQ[#[[2]]],Nothing,#]&[With[{n=2RandomInteger[2^2^5/2]},n->FirstPosition[Total/@CellularAutomaton[{n,2,2},{{1},0},{20,All}],0]]],100000],Last],10]
Out[]=
{2427987380{11},876529444{10},3774138276{7},3428773284{7},2049967540{7},211056996{7},2224866724{6},1956439332{6},1087686564{6},1084016036{6}}
In[]:=
ArrayPlot[CellularAutomaton[{First[#],2,2},{{1},0},{15,All}],Mesh->True]&/@%39
Out[]=

,
,
,
,
,
,
,
,
,

In[]:=
Take[ReverseSortBy[ParallelTable[If[MissingQ[#[[2]]],Nothing,#]&[With[{n=2RandomInteger[2^2^5/2]},n->FirstPosition[Total/@CellularAutomaton[{n,2,2},{{1},0},{20,All}],0]]],10^6],Last],10]
Out[]=
{1413482900{13},452103588{13},3633325492{12},3499763124{12},81414500{12},3640264612{10},3089026468{9},1352533940{9},855541172{9},2960821140{8}}
In[]:=
ArrayPlot[CellularAutomaton[{First[#],2,2},{{1},0},{15,{-8,8}}],Mesh->True]&/@%58
Out[]=

,
,
,
,
,
,
,
,
,

NOTE: the above were cut off too early

Widths

All monotonic:
Check for increase, and that variance remains bounded

k=2, r=5/2

k=3, r=1/2

k=4, r=1/2

This isn’t everything:::

k=5, r=1/2

k=6, r=1/2

k=3, r=1

k=4, r=1

Undecidability

Given a certain number of steps, will there be a rule that achieves it?