Complex Behavior in Digit Sequences

Produced via Simple Iterated Maps

Christopher Maes

Outline

Introduction

Reversal Addition

Classes of Behavior

Equivalent and Unique Sequences

Complexity

Analysis

Generalized Reversal Addition Maps

Enumeration of Primitive Functions

Interesting Functions

Further Work

Introduction

Definition

Let f(x, (Subscript[x, b])) be a function on \(TraditionalForm\`x ∈ \ \(ℤ\^+\)\) and the digit representation of x in base b. Further restrict f to be composed of primitive arithmetic functions such as addition and multiplication and primitive digit representation functions such as reverse, rotate, pad and bitwise and, or, and xor.

Example of the Reversal Addition map

Consider the sequence (Subscript[x, 0]),  ...  , (Subscript[x, N]) such that successive terms in the sequence are given by
	(Subscript[x, n + 1]) = (Subscript[x, n]) + R((Subscript[(((Subscript[x, n]))), b]))

So in base 10 with (Subscript[x, 0]) = 11the first six terms in the sequence are as follows

disptbl[11, 10, 6]

disptbl[10, 10, 4]

Reversal Addition

Classes of Behavior

The Reversal Addition map yields three distinct types of behavior: simple repetitive structures, transient random behavior, and long term random behavior. These three types of behavior first appear at initial conditions 1, 16, and 271 respectively. 
Here are 200 terms in the digit sequence for these initial conditions.

Show[
            GraphicsArray[{mdisp[#, 2, ReverseAdd, 200, 3], 
                iadisp2[InverseAdd[#, 2, 200], 2, 3]}], 
            PlotLabel -> "200 steps for inital condition " <> 
                ToString[#]] & /@ {1, 16, 271};

Equivalent and Unique Sequences

Let (Subscript[x, 0]) be the initial condition and \(TraditionalForm\`\(x\_0\)\&_\) it's reversal in base b. Then (Subscript[x, 1]) = (Subscript[x, 0])+\(\(x\_0\)\&_\) and thus (OverBar[(Subscript[x, 0])]) is an equivalent initial condition for the sequence (Subscript[x, 1]), (Subscript[x, 2]),  ...  , (Subscript[x, n]) since 
\(TraditionalForm\`x\_1 = \(\(x\_0\)\&_ + \ \(\(x\_0\)\&_\)\&_\  = \ \ \(\(x\_0\)\(\ \)\)\&_\  + \ x\_0\)\) and will thus generate an equivalent sequence.

FromDigits[Reverse[IntegerDigits[271, 2]], 2]

disptbl[271, 2, 5]

disptbl[481, 2, 5]

Consider reversal in base 10.  With initial conditions (Subscript[x, 0]) = 23 and (Subscript[y, 0])=14then (Subscript[x, 1]) = 23 + 32 = 55 and (Subscript[y, 1]) = 14 + 41 = 55. So the sequences with initial conditions (Subscript[x, 0])and (Subscript[y, 0])are equivalent after 1 step.

disptbl[23, 10, 5]

disptbl[14, 10, 5]

It is of interest to enumerate all the initial conditions from 1 to N, which yield a unique sequence. Let M be the number of iterations for a each initial condition. The algorithm for computing unique sequences is of order O((N - 2  M) (M)) = O(N M - 2  (M^2) ) = 
          O(N M). In practice this constant speedup is significant.

Timing[isearch[1, 1000]]

With the unique initial conditions one can see all the behavior that occurs in the first 1000 initial conditions.

Show[iadisp2[ReverseAdd[#, 2, 200], 2, 3], 
            PlotLabel -> "200 steps for inital condition " <> 
                ToString[#]] & /@ {1, 16, 64, 74, 98, 107, 259, 266, 271, 
          275, 298, 398, 442, 454, 522, 794, 911};

In NKS Wolfram gives initial condition 512 as one that yields complex behavior. Notice that 512 is not in the list of unique initial conditions. This is because 512 is equivalent to 271 after four steps.

disptbl[271, 2, 5]

disptbl[512, 2, 5]

Data

In the first 100000 initial conditions there are only 232 unique sequences, of these 232 unique sequences only 34 continue to be random after the first 500 iterations. Empirically if a sequence is random after the first 500 iterations it stays random for the first million iterations

Background

There exists an open problem in recreational mathematics involving the Reversal Map in base 10 (196 problem).   Is there a sequence which does not form a palindrome? This question is equivalent to asking if there is any repetitive behavior in base 10.

Complexity

A good measure of the complexity of a sequence is the number of blocks it takes to encode the digit representation of successive numbers in the sequence.  Notice that the repetitive behavior contains long strings of 1's and 0's.  Thus it can be easily compressed via run-length encoding. The following plots show the number of blocks as a function of n for the three types of behavior.

(ListPlot[Length[runlength[IntegerDigits[#, 2]]] & /@ 
                InverseAdd[#, 2, 300], PlotJoined -> True]) & /@ {1, 
          16, 271};

For the complex behavior one expects the number of blocks required to encode a number to increase as a function of n. For repetitive behavior the number of blocks required will eventually reach a limit cycle.

try = {1, 16, 64, 74, 98, 107, 259, 266, 275, 298, 398, 442, 454, 
          522, 794, 911, 1027, 1046, 1057, 1066, 1070, 1073, 1076, 1081, 
          1082, 1085, 1115, 1274, 1562, 1570, 1967, 2070, 2329, 3355, 3871, 
          4099, 4114, 4120, 4126, 4152, 4182, 4189, 4202, 4204, 4213, 4214, 
          4217, 4264, 4322, 4337, 4600, 4601, 4633, 4666, 6166, 6170, 6215, 
          6222, 6254, 6262, 6374, 7174, 8307, 8312, 8697, 8758, 9241, 9326, 
          9453, 9466, 11278, 12302, 16418, 16426, 16458, 16464, 16490, 16537, 
          16577, 16601, 16613, 16616, 16726, 16741, 16748, 16753, 16874, 
          16994, 17002, 17267, 17273, 17428, 17497, 17533, 17885, 18035, 
          18301, 18457, 18585, 20474, 20622, 24610, 24642, 24674, 24771, 
          25574, 31342, 32806, 32888, 32912, 32970, 33233, 33777, 33779, 
          33785, 33853, 33896, 33958, 33969, 34530, 34786, 34870, 34938, 
          35037, 37626, 37870, 38969, 39069, 39642, 40957, 41102, 49174, 
          49214, 49230, 49274, 50158, 50227, 50286, 51187, 57359, 65546, 
          65552, 65590, 65604, 65610, 65632, 65642, 65694, 65714, 65750, 
          65758, 65843, 65881, 65888, 65890, 65902, 66008, 66017, 66038, 
          66242, 66251, 66266, 66289, 66454, 66457, 66458, 66502, 66514, 
          66530, 66664, 66917, 67297, 67553, 67569, 67577, 67633, 67681, 
          68266, 68582, 68596, 68729, 68849, 69601, 69610, 69686, 69818, 
          71642, 71668, 75130, 81021, 82126, 82142, 82286, 90510, 98318, 
          98407, 98582, 98710};

ListPlot[
      cyclic /@ Map[
          Length[runlength[IntegerDigits[#, 2]]] &, Take[
                InverseAdd[#, 2, 
                  800], -32] & /@ 
try, {2}], 
      PlotRange -> All, AxesOrigin -> {0, 1.9}]

whole = {1, 16, 64, 74, 98, 107, 259, 266, 271, 275, 298, 398, 442, 
          454, 522, 794, 911, 1027, 1046, 1057, 1066, 1070, 1073, 1076, 1081, 
          1082, 1085, 1115, 1274, 1422, 1562, 1570, 1967, 2070, 2329, 3106, 
          3355, 3871, 4099, 4114, 4120, 4126, 4136, 4152, 4182, 4189, 4202, 
          4204, 4213, 4214, 4217, 4262, 4264, 4322, 4337, 4600, 4601, 4633, 
          4666, 6166, 6170, 6182, 6215, 6222, 6254, 6262, 6374, 7174, 8214, 
          8307, 8312, 8697, 8758, 9241, 9326, 9453, 9466, 11278, 12302, 
          16418, 16426, 16458, 16464, 16480, 16490, 16537, 16577, 16601, 
          16613, 16616, 16726, 16741, 16748, 16753, 16874, 16994, 17002, 
          17006, 17267, 17273, 17428, 17497, 17498, 17530, 17533, 17885, 
          18035, 18301, 18457, 18585, 19962, 20474, 20622, 24610, 24642, 
          24674, 24771, 25202, 25574, 31342, 32806, 32888, 32912, 32970, 
          33233, 33777, 33779, 33785, 33853, 33896, 33898, 33958, 33969, 
          34530, 34786, 34870, 34938, 35037, 35060, 37626, 37870, 38969, 
          39069, 39642, 40957, 41102, 49174, 49214, 49230, 49274, 50158, 
          50227, 50286, 51187, 57359, 57542, 65546, 65552, 65590, 65604, 
          65610, 65618, 65632, 65642, 65678, 65694, 65714, 65750, 65758, 
          65843, 65859, 65881, 65888, 65890, 65902, 65945, 66008, 66017, 
          66038, 66186, 66242, 66251, 66266, 66289, 66454, 66457, 66458, 
          66502, 66514, 66530, 66664, 66806, 66917, 67297, 67321, 67553, 
          67569, 67577, 67633, 67681, 68266, 68529, 68582, 68596, 68729, 
          68849, 69090, 69601, 69610, 69652, 69681, 69686, 69818, 71642, 
          71668, 74221, 75130, 79866, 81021, 82061, 82126, 82142, 82286, 
          90510, 91022, 98318, 98370, 98407, 98446, 98522, 98582, 
          98710};

ListPlot[
      cyclic /@ Map[
          Length[runlength[IntegerDigits[#, 2]]] &, Take[
                InverseAdd[#, 2, 
                  800], -32] & /@ 
whole, {2}], 
      PlotRange -> All, AxesOrigin -> {0, 0}]

What are they computing?

If one considers these iterated maps to be performing some calculation it is possible to define those maps which yield repetitive behavior as those which have halted or completed the calculation, and those which display continuous random behavior as performing an infinite loop.

Show[iadisp2[ReverseAdd[#, 2, 200], 2, 3], 
            PlotLabel -> "200 steps for inital condition " <> 
                ToString[#]] & /@ {16, 271};

Analysis

Carry Propagation

Unlike a Cellular Automata where a cell can only be affected by its neighbors under the Reverse Add map a carry can travel arbitrary far, thus non-local behavior can occur. To visualize this propagation of carries color the carry chain green, and the final resting place of the carry red.

Show[cadisp[Last /@ CReverseAdd[#, 2, 200]]] & /@ {1, 16, 
          271};

For repetitive behavior the carry propagates to the system's local structures and then must stop. For complex behavior  multiple carries occur throughout the entire system.

Mutation

One way to examine this nonlinear behavior is to mutate a single bit in the initial condition and track the differences in the simultaneous evolution of the two systems.

Show[mudisp[rdiff[27021597965549565, 100]]]

Show[mudisp[rdiff[28334200664512675184643, 100]]]

Show[mudisp[rdiff[28334200664512675184643, 100]]];

ListPlot[
      Round /@ (Mean /@ 
            Transpose[Table[lrdiff[27021597965549565, 200], {20}]]), 
      PlotJoined -> True]

ListPlot[
      Round /@ (Mean /@ 
            Transpose[Table[lrdiff[28334200664512675184643, 200], {20}]]), 
      PlotJoined -> True]

Structures and Symmetry

In order for large scale structures not to be destroyed under this reversal map, they must be symmetrical around the center. Consider the following graphics. Orange and red represent breaks in symmetry.

Show[iadisp3[ReverseAdd[#, 2, 500], 2, 2]] & /@ {271, 6182, 
          8214};

Generalized Reversal Addition Maps

Enumeration of Primitive Maps

sv = 
      seive[(Function[x, #] & /@ 
            Union[trees[{Plus, rv, rl, rr}, {1, x}, 4]]), {lengtest, 
          sametest}]

Show[GraphicsArray[Table[iadisp2[NestList[#, i, 50]], {i, 5}]], 
            PlotLabel -> ToString[#]] & /@ 
        Select[sv, 
          Or[MemberQ[#, rv, {0, Infinity}, Heads -> True], 
              MemberQ[#, rr, {0, Infinity}, Heads -> True], 
              MemberQ[#, rl, {0, Infinity}, 
                Heads -> True]] &];

Show[
            GraphicsArray[Table[iadisp2[NestList[#, i, 200], 2, 4], {i, 5}]], 
            PlotLabel -> ToString[#]] & /@ {Function[x, 
            x + rv[1 + x]], Function[x, 2 x + rv[x]], 
          Function[x, 1 + x + rv[x]], Function[x, x + rr[rv[x], 1]], 
          Function[x, x + rv[rl[x, 1]]]};

x->1+x+Reverse[x]

Show[
            iadisp2[NestList[(FromDigits[Reverse[IntegerDigits[#, 2]], 
                        2] + # + 1) &, #, 300]]] & /@ {1, 2, 5, 17, 21, 
          27, 62, 65, 93, 652, 783, 795};

Show[
          iadisp2[NestList[(FromDigits[Reverse[IntegerDigits[#, 2]], 
                      2] + # + 1) &, #, 700]]] &[652]

x->2x + Reverse[x]

Show[
            iadisp2[NestList[(FromDigits[Reverse[IntegerDigits[#, 2]], 2] + 
                      2  #) &, #, 300]]] & /@ {1, 2, 11, 13, 16, 38, 47, 
          49, 78, 83, 87, 95, 128, 134, 137, 142, 151, 157, 163, 167, 191, 
          193, 221, 223, 235, 239, 256, 264, 268, 322, 367, 385, 520, 528, 
          533, 542, 569, 647, 651, 671, 699, 702, 727, 766, 769, 775, 799, 
          809, 827, 899};

Conjecture

Any function in the form f(x)  +  R(g(x))will yield interesting behavior for some initial conditions.

Further Work

Local Structures

Acknowledgements

Jake West

Øyvind Tafjord == m4D mathematica h4x0r