Initial conditions [for rule 110]

The following takes the rules for a cyclic tag system in the form used on page 895 (with the restrictions in the note below), together with the initial conditions for the tag system, and yields a specification of initial conditions in rule 110 which will emulate it. This specification gives a list of three blocks {b₁, b₂, b₃} and the final initial conditions consist of an infinite repetition of b₁ blocks, followed by b₂, followed by an infinite repetition of b₃ blocks. The b₁ blocks act like "clock pulses", b₂ encodes the initial conditions for the tag system and the b₃ blocks encode the rules for the tag system.

CTToR110[rules_ /; Select[rules, Mod[Length[#], 6] ≠ 0 &]  {}, init_] := Module[{g1, g2, g3, nr = 0, x1, y1, sp}, g1 = Flatten[Map[If[#1 === {}, {{{2}}}, {{{1, 3, 5 - First[#1]}}, Table[{4, 5 - #〚n〛}, {n, 2, Length[#]}]}] &, rules] /. a_Integer  Map[({d[#〚1〛, #〚2〛], s[#〚3〛]}) &, Partition[c[a], 3]], 4]; g2 = g1 = MapThread[If[#1 === #2 === {d[22, 11], s3}, {d[20, 8], s3}, #1] &, {g1, RotateRight[g1, 6]}]; While[Mod[Apply[Plus, Map[#〚1, 2〛 &, g2, 30] ≠ 0, nr++; g2 = Join[g2, g1]]; y1 = g2〚1, 1, 2〛 - 11; If[y1 < 0, y1 += 30]; Cases[Last[g2]〚2〛, s[d[x_, y1], _, _, a_]  (x1 = x + Length[a])]; g3 = Fold[sadd, {d[x1, y1], {}}, g2]; sp = Ceiling[5 Length[g3〚2〛]/(28 nr) + 2]; {Join[Fold[sadd, {d[17, 1], {}}, Flatten[Table[{{d[sp 28 + 6, 1], s[5]}, {d[398, 1], s[5]}, {d[342, 1], s[5]}, {d[370, 1], s[5]}}, {3}], 1]]〚2〛, bg[4, 11]], Flatten[Join[Table[bgi, {sp 2 + 1 + 24 Length[init]}], init /. {0  init0, 1  init1}, bg[1, 9], bg[6, 60 - g2〚1, 1, 1〛 + g3〚1, 1〛 + If[g2〚1, 1, 2〛 < g3〚1, 2〛, 8, 0]]]], g3〚2〛}]

s[1] = struct[{3, 0, 1, 10, 4, 8}, 2];

s[2] = struct[{3, 0, 1, 1, 619, 15}, 2];

s[3] = struct[{3, 0, 1, 10, 4956, 18}, 2];

s[4] = struct[{0, 0, 9, 10, 4, 8}];

s[5] = struct[{5, 0, 9, 14, 1, 1}];

{c[1], c[2]} = Map[Join[{22, 11, 3, 39, 3, 1}, #] &, {{63, 12, 2, 48, 5, 4, 29, 26, 4, 43, 26, 4, 23, 3, 4, 47, 4, 4}, {87, 6, 2, 32, 2, 4, 13, 23, 4, 27, 16, 4}}];

{c[3], c[4], c[5]} = Map[Join[#, {4, 17, 22, 4, 39, 27, 4, 47, 4, 4}] &, {{17, 22, 4, 23, 24, 4, 31, 29}, {17, 22, 4, 47, 18, 4, 15, 19}, {41, 16, 4, 47, 18, 4, 15, 19}}]

{init0, init1} = Map[IntegerDigits[216 (# + 432 10⁴⁹), 2] &, {246005560154658471735510051750569922628065067661, 1043746165489466852897089830441756550889834709645}]

bgi = IntegerDigits[9976, 2]

bg[s_, n_] := Array[bgi〚1 + Mod[# - 1, 14]〛 &, n, s]

ev[s[d[x_, y_], pl_, pr_, b_]] := Module[{r, pl1, pr1}, r = Sign[BitAnd[2^ListConvolve[{1, 2, 4}, Join[bg[pl - 2, 2], b, bg[pr, 2]]], 110]]; pl1 = (Position[r - bg[pl + 3, Length[r]], 1 | -1] /. {}  {{Length[r]}})〚1, 1〛; pr1 = Max[pl1, (Position[r - bg[pr + 5 - Length[r], Length[r]], 1 | -1] /. {}  {{1}})〚-1, 1〛]; s[d[x + pl1 - 2, y + 1], pl1 + Mod[pl + 2, 14], 1 + Mod[pr + 4, 14] + pr1 - Length[r], Take[r, {pl1, pr1}]]]

struct[{x_, y_, pl_, pr_, b_, bl_}, p_Integer : 1] := Module[{gr = s[d[x, y], pl, pr, IntegerDigits[b, 2, bl]], p2 = p + 1}, Drop[NestWhile[Append[#, ev[Last[#]]] &, {gr}, If[Rest[Last[#]] === Rest[gr], p2--]; p2 > 0 &], -1]]

sadd[{d[x_, y_], b_}, {d[dx_, dy_], st_}] := Module[{x1 = dx - x, y1 = dy - y, b2, x2, y2}, While[y1 > 0, {x1, y1} += If[Length[st]  30, {8, -30}, {-2, -3}]]; b2 = First[Cases[st, s[d[x3_, -y1], pl_, _, sb_]  Join[bg[pl - x1 - x3, x1 + x3], x2 = x3 + Length[sb]; y2 = -y1; sb]]]; {d[x2, y2], Join[b, b2]}]

CTToR110[{{}}, {1}] yields blocks of lengths {7204, 1873, 7088}. But even CTToR110[{{0, 0, 0, 0, 0, 0}, {}, {1, 1, 1, 1, 1, 1}, {}}, {1}] already yields blocks of lengths {105736, 34717, 95404}. The picture below shows what happens if one chops these blocks into rows and arranges these in 2D arrays. In the first two blocks, much of what one sees is just padding to prevent clock pulses on the left from hitting data in the middle too early on any given step. The part of the middle block that actually encodes an initial condition grows like 180 Length[init]. The core of the right-hand block grows approximately like 500 (Length[Flatten[rules]] + Length[rules]), but to make a block that can just be repeated without shifts, between 1 and 30 repeats of this core can be needed.