If[Mod[n,2]0,n/2,3n+1]
In[]:=
(3/4)^(1/3)//N
Out[]=
0.90856
Switch[Mod[n,3],0,n/3,1,a1+nb1,2,a2+nb2]
Switch[Mod[n,6],0,n/6,1,
Tag System Emulation
Tag System Emulation
In[]:=
Clear[TSEvolveList]
In[]:=
TSEvolveList[{n_Integer,rule_},init_,t_]:=NestWhileList[Join[Drop[#,n],Replace[First[#],rule]]&,init,Length[#]≥n&,1,t]
In[]:=
TSEvolveList[{2,{1{2,3},2{1},3{1,1,1}}},{1,1,1},Infinity]
Out[]=
{{1,1,1},{1,2,3},{3,2,3},{3,1,1,1},{1,1,1,1,1},{1,1,1,2,3},{1,2,3,2,3},{3,2,3,2,3},{3,2,3,1,1,1},{3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1},{1,1,1,1,1,1,2,3},{1,1,1,1,2,3,2,3},{1,1,2,3,2,3,2,3},{2,3,2,3,2,3,2,3},{2,3,2,3,2,3,1},{2,3,2,3,1,1},{2,3,1,1,1},{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1},{1,1},{2,3},{1}}
In[]:=
TSEvolveList[{2,{1{2,3},2{1},3{1,1,1}}},{1,1,1,1},Infinity]
Out[]=
{{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1},{1,1},{2,3},{1}}
In[]:=
TSEvolveList[{2,{1{2,3},2{1},3{1,1,1}}},Table[1,12],Infinity]
Out[]=
{{1,1,1,1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1,2,3},{1,1,1,1,1,1,1,1,2,3,2,3},{1,1,1,1,1,1,2,3,2,3,2,3},{1,1,1,1,2,3,2,3,2,3,2,3},{1,1,2,3,2,3,2,3,2,3,2,3},{2,3,2,3,2,3,2,3,2,3,2,3},{2,3,2,3,2,3,2,3,2,3,1},{2,3,2,3,2,3,2,3,1,1},{2,3,2,3,2,3,1,1,1},{2,3,2,3,1,1,1,1},{2,3,1,1,1,1,1},{1,1,1,1,1,1},{1,1,1,1,2,3},{1,1,2,3,2,3},{2,3,2,3,2,3},{2,3,2,3,1},{2,3,1,1},{1,1,1},{1,2,3},{3,2,3},{3,1,1,1},{1,1,1,1,1},{1,1,1,2,3},{1,2,3,2,3},{3,2,3,2,3},{3,2,3,1,1,1},{3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1},{1,1,1,1,1,1,2,3},{1,1,1,1,2,3,2,3},{1,1,2,3,2,3,2,3},{2,3,2,3,2,3,2,3},{2,3,2,3,2,3,1},{2,3,2,3,1,1},{2,3,1,1,1},{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1},{1,1},{2,3},{1}}
In[]:=
ArrayPlot[PadRight[TSEvolveList[{2,{1{2,3},2{1},3{1,1,1}}},Table[1,12],Infinity]]]
Out[]=
In[]:=
ArrayPlot[PadRight[TSEvolveList[{2,{1{2,3},2{1},3{1,1,1}}},Table[1,19],Infinity]]]
Out[]=
In[]:=
Length/@Cases[TSEvolveList[{2,{1{2,3},2{1},3{1,1,1}}},Table[1,19],Infinity],{1...}]
Out[]=
{19,29,44,22,11,17,26,13,20,10,5,8,4,2,1}
Adding 1 in unary
In[]:=
TSEvolveList[{2,{1{1,1,1}}},{1,1,1},10]
Out[]=
{{1,1,1},{1,1,1,1},{1,1,1,1,1},{1,1,1,1,1,1},{1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1,1,1,1}}
Ceiling [ 3/2 ^ n ]
In[]:=
TSEvolveList[{2,{1{2,2},2{1,1,1}}},{1,1,1},20]
Out[]=
{{1,1,1},{1,2,2},{2,2,2},{2,1,1,1},{1,1,1,1,1},{1,1,1,2,2},{1,2,2,2,2},{2,2,2,2,2},{2,2,2,1,1,1},{2,1,1,1,1,1,1},{1,1,1,1,1,1,1,1},{1,1,1,1,1,1,2,2},{1,1,1,1,2,2,2,2},{1,1,2,2,2,2,2,2},{2,2,2,2,2,2,2,2},{2,2,2,2,2,2,1,1,1},{2,2,2,2,1,1,1,1,1,1},{2,2,1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1,2,2},{1,1,1,1,1,1,1,1,2,2,2,2}}
In[]:=
ArrayPlot[PadRight[TSEvolveList[{2,{1{2,2},2{1,1,1}}},{1,1},40],Automatic,.25]]
Out[]=
In[]:=
Total/@Cases[TSEvolveList[{2,{1{2,2},2{1,1,1}}},{1,1},500],{1...}]
Out[]=
{2,3,5,8,12,18,27,41,62,93,140,210}
In[]:=
NestList[Ceiling[3/2#]&,1,20]
Out[]=
{1,2,3,5,8,12,18,27,41,62,93,140,210,315,473,710,1065,1598,2397,3596,5394}
In[]:=
TSEvolveList[{2,{1{2,3},2{1,1,1},3{1}}},{1,1,1},20]
Out[]=
{{1,1,1},{1,2,3},{3,2,3},{3,1},{1}}
In[]:=
Length[%199]
Out[]=
5
In[]:=
TSEvolveList[{2,{1{2,3},2{1,1,1},3{1}}},{1,1,1,1,1},20]
Out[]=
{{1,1,1,1,1},{1,1,1,2,3},{1,2,3,2,3},{3,2,3,2,3},{3,2,3,1},{3,1,1},{1,1},{2,3},{1,1,1},{1,2,3},{3,2,3},{3,1},{1}}
In[]:=
Length[%]
Out[]=
13
In[]:=
TSEvolveList[{2,{1{2,3},2{1,1,1},3{1}}},{1,1,1,1},100]
Out[]=
{{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1,1,1},{1,1,1,1,1,1},{1,1,1,1,2,3},{1,1,2,3,2,3},{2,3,2,3,2,3},{2,3,2,3,1,1,1},{2,3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,2,3},{1,1,1,1,1,2,3,2,3},{1,1,1,2,3,2,3,2,3},{1,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,1},{3,2,3,2,3,1,1},{3,2,3,1,1,1},{3,1,1,1,1},{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1,1,1},{1,1,1,1,1,1},{1,1,1,1,2,3},{1,1,2,3,2,3},{2,3,2,3,2,3},{2,3,2,3,1,1,1},{2,3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,2,3},{1,1,1,1,1,2,3,2,3},{1,1,1,2,3,2,3,2,3},{1,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,1},{3,2,3,2,3,1,1},{3,2,3,1,1,1},{3,1,1,1,1},{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1,1,1},{1,1,1,1,1,1},{1,1,1,1,2,3},{1,1,2,3,2,3},{2,3,2,3,2,3},{2,3,2,3,1,1,1},{2,3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,2,3},{1,1,1,1,1,2,3,2,3},{1,1,1,2,3,2,3,2,3},{1,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,1},{3,2,3,2,3,1,1},{3,2,3,1,1,1},{3,1,1,1,1},{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1,1,1},{1,1,1,1,1,1},{1,1,1,1,2,3},{1,1,2,3,2,3},{2,3,2,3,2,3},{2,3,2,3,1,1,1},{2,3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,2,3},{1,1,1,1,1,2,3,2,3},{1,1,1,2,3,2,3,2,3},{1,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,1},{3,2,3,2,3,1,1},{3,2,3,1,1,1},{3,1,1,1,1},{1,1,1,1},{1,1,2,3},{2,3,2,3},{2,3,1,1,1},{1,1,1,1,1,1},{1,1,1,1,2,3},{1,1,2,3,2,3},{2,3,2,3,2,3},{2,3,2,3,1,1,1},{2,3,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,2,3},{1,1,1,1,1,2,3,2,3},{1,1,1,2,3,2,3,2,3},{1,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,2,3},{3,2,3,2,3,2,3,1},{3,2,3,2,3,1,1},{3,2,3,1,1,1},{3,1,1,1,1},{1,1,1,1}}
More
More
Powers of 2
Related to binary decomposition of numbers.....
Powers of 3?
3n+1 case
3n+1 case
I.e. nonlooping
? Fibonacci
? Fibonacci
ABC etc.
ABC etc.
Catalan conjecture (proved in 2002) : only place where there are 2 adjacent powers....
+ modulus m
For some i, a[i] n + b[i] is divisible by m for all n
If a[i] i + b[i] is divisible by m^p
Possible mod 3 cases
Possible mod 3 cases
Find the possible sets of vectors for a given m that can work...
Then find their weightings.....
Then find their weightings.....
You are in a state k mod m. If you land on each element, what state do you transition to?
Mod 4
GeneralizedCollatz[{{1, 0}, {3, -3}, {5, -2}, {17, 1}}, k]
is good. But the following is “smoother”
GeneralizedCollatz[{{1, 0}, {6, -2}, {6, 0}, {7, 3}}, k]
GeneralizedCollatz[{{1, 0}, {3, -3}, {5, -2}, {17, 1}}, k]
is good. But the following is “smoother”
GeneralizedCollatz[{{1, 0}, {6, -2}, {6, 0}, {7, 3}}, k]