NKS 2004 Posters

Although many of the posters presented at this conference appear to be extremely complex, 
the code needed to generate them is often very simple.  In the hopes that more artwork of this 
type can be created, here is a notebook of the artwork displayed at NKS 2004.

Initialization

center = {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}, {{0, 0, 0}, {0, 1, 
              0}, {0, 0, 0}}, {{0, 0, 0}, {0, 0, 0}, {0, 0, 
              0}}};

face = {{{0, 0, 0}, {0, 1, 0}, {0, 0, 0}}, {{0, 1, 0}, {1, 0, 1}, {0, 
              1, 0}}, {{0, 0, 0}, {0, 1, 0}, {0, 0, 0}}};

edge = {{{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}, {{1, 0, 1}, {0, 0, 0}, {1, 
              0, 1}}, {{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}};

corner = {{{1, 0, 1}, {0, 0, 0}, {1, 0, 1}}, {{0, 0, 0}, {0, 0, 
              0}, {0, 0, 0}}, {{1, 0, 1}, {0, 0, 0}, {1, 0, 
              1}}};

RasterGraphics[state_, colors_:  2, size_:  1] := 
      With[{dim = Reverse[Dimensions[state]]}, 
        Graphics[Raster[Reverse[1 - state/(colors - 1)]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, dim[[1]]}, {0, dim[[2]]}}, 
          ImageSize -> size*dim + 1]]

InsertLines[datain_, numint_ : 1, numext_ : 1, insertin_ : Automatic] := 
      Module[{data = datain, numx, numy, insert}, {numy, numx} = 
          Take[Dimensions[data], 2]; 
        insert = If[insertin === Automatic, Max[data] + 1, insertin]; 
        data = Flatten[Map[Flatten, Transpose /@ data, {2}], 1]; 
        data = Insert[data, Table[insert, {Length[data[[1]]]}], 
            Flatten[Table[
                If[i == 1 || i == Length[data] + 1, 
                  Table[{i}, {numext}], Table[{i}, {numint}]], {i, 1, 
                  Length[data] + 1, Length[data]/numy}], 1]]; 
        data = Transpose[
            Insert[Transpose[data], Table[insert, {Length[data]}], 
              rr = Flatten[
                  Table[If[
                      i == 1 || i == Length[data[[1]]] + 1, 
                      Table[{i}, {numext}], Table[{i}, {numint}]], {i, 1, 
                      Length[data[[1]]] + 1, 
                      Length[data[[1]]]/numx}], 1]]]]

Images for NKS 2004 
by Wolfram Research

3DFaceCASlices

Ed Pegg Jr took a look at some of the 3D cellular automata that grow from a single cell—a cube, in this lattice.  The simplest cases all grow from the faces of that particular starting cube.  Once the CA has grown 24 steps, it is then slid apart into layers for easy viewing.

FaceList  =  
      Sort[Map[Last, 
          Union[Table[{Map[Flatten, 
                  Transpose[
                    Last[CellularAutomaton[{i, {2, face}, {1, 1, 
                            1}}, {{{{1}}}, 0}, 
                        24, {-1, All, All, All}]], {2, 1}]], i}, {i, 0, 
                2^7 - 1}], 
            SameTest ->  (First[#1] == 
                    First[#2] &)]]]

RasterGraphics[
        InsertLines[
          2 Map[Last[
                  CellularAutomaton[{#, {2, face}, {1, 1, 1}}, {{{{1}}}, 0}, 
                    24, {-1, All, All, All}]] &, FaceList], 1, 3, 1], 3, 
        1];

Show[%]

3DEdgeCASlices

Ed Pegg Jr took a look at some of the 3D cellular automata that grow from a single cell—a cube,in this lattice.  The simplest cases all grow from the faces of that particular starting cube.  Once the CA has grown 24 steps,it is then slid apart into layers for easy viewing.

EdgeList  =  {0, 1, 2, 6, 14, 18, 22, 26, 30, 38, 46, 50, 54, 58, 
          62, 66, 70, 74, 78, 82, 86, 90, 94, 98, 102, 106, 110, 114, 118, 
          122, 126, 134, 142, 146, 150, 154, 158, 166, 174, 178, 182, 186, 
          190, 198, 202, 206, 210, 214, 218, 222, 230, 234, 238, 242, 246, 
          250, 254, 257, 258, 261, 262, 265, 266, 269, 270, 273, 274, 277, 
          278, 281, 282, 285, 286, 289, 290, 293, 294, 297, 298, 301, 302, 
          305, 306, 309, 310, 313, 314, 317, 318, 321, 322, 325, 326, 329, 
          330, 333, 334, 337, 338, 341, 342, 345, 346, 349, 350, 353, 354, 
          357, 358, 361, 362, 365, 366, 369, 370, 373, 374, 377, 378, 381, 
          382, 385, 386, 389, 390, 393, 394, 397, 398, 401, 402, 405, 406, 
          409, 410, 413, 414, 417, 418, 421, 422, 425, 426, 429, 430, 433, 
          434, 437, 438, 441, 442, 445, 446, 449, 450, 453, 454, 457, 458, 
          461, 462, 465, 466, 469, 470, 473, 474, 477, 478, 481, 482, 485, 
          486, 489, 490, 493, 494, 497, 498, 501, 502, 505, 506, 509, 510, 
          518, 526, 530, 534, 538, 542, 550, 558, 562, 566, 570, 574, 582, 
          586, 590, 594, 598, 602, 606, 610, 614, 618, 622, 626, 630, 634, 
          638, 646, 654, 658, 662, 666, 670, 678, 686, 690, 694, 698, 702, 
          710, 714, 718, 722, 726, 730, 734, 738, 742, 746, 750, 754, 758, 
          762, 766, 769, 770, 773, 774, 777, 778, 781, 782, 785, 786, 789, 
          790, 793, 794, 797, 798, 801, 802, 805, 806, 809, 810, 813, 814, 
          817, 818, 821, 822, 825, 826, 829, 830, 833, 837, 838, 841, 842, 
          845, 846, 849, 850, 853, 854, 857, 858, 861, 862, 865, 869, 870, 
          873, 874, 877, 878, 881, 882, 885, 886, 889, 890, 893, 894, 897, 
          898, 901, 902, 905, 906, 909, 910, 913, 914, 917, 918, 921, 922, 
          925, 926, 929, 930, 933, 934, 937, 938, 941, 942, 945, 946, 949, 
          950, 953, 954, 957, 958, 961, 962, 965, 966, 969, 970, 973, 974, 
          977, 978, 981, 982, 985, 986, 989, 990, 993, 994, 997, 
          998};

RasterGraphics[
        InsertLines[
          2 Map[Last[
                  CellularAutomaton[{#, {2, center +  edge}, {1, 1, 
                        1}}, {{{{1}}}, 0}, 24, {-1, All, All, All}]] &, 
              Take[EdgeList, {4, 52}]], 1, 3, 1], 3, 1];

Show[%];

3DCenterFaceCASlices

RasterGraphics[
        InsertLines[
          2 Map[Last[
                  CellularAutomaton[{#, {2, center + face}, {1, 1, 
                        1}}, {{{{1}}}, 0}, 24, {-1, All, All, All}]] &, 
              Take[CenterFaceList, 48]], 1, 3, 1], 3, 1];

Biomorph

Show[
      RasterGraphics[
        Floor[20 Mod[
              Table[Sort[
                    Flatten[
                      Map[{Abs[#]} &, 
                        NestList[
                          Mod[#, 2]^2  +  
                              Cos[Mod[#, 2]]  +  ( .3  +   .4 I) &, 
                          n + m I, 10]]]][[4]], {n, 0, 3,  .004}, {m, 
                  0, 3,  .004}], 1]], 20, 1]]

ComplexNumberRounding

DensityPlot[
        Abs[1/(x + I y) 220 - 
            Floor[1/(x + I y) 220]], {x, -220, 220}, {y, -220, 
          220}, PlotPoints -> 400, ColorFunction -> Hue, 
        Mesh -> False, Frame -> False];

Elementary Rules

Show[
        RasterGraphics[
          InsertLines[
            2 Partition[CellularAutomaton[#, {{1}, 0}, 
                      50, {All, All}] & /@ {18, 30, 45, 73, 105, 110, 150, 
                    225}, 4], 2, 3, 1], 3, 1]];

Famous2DCA

init  =  Table[Random[Integer], {150}, {150}];

\({{{0, "Initial Condition"}, {12, "Gnarl"}, {16, "Seeds"}, {224, "Game of Life"}, {746, "Mazectric"}}, {{960, "34 Life"}, {1376, "Blinkers"}, {3392, "Long Life"}, {6248, "2x2"}, {6752, "Rule 6752"}}, {{11072, "Bacteria"}, {72288, "Move"}, {83168, "Rule 83168"}, {90016, "Walled Cities"}, {148704, "Pseudo Life"}}, {{150728, "Amoeba"}, {174656, "Coral"}, {174826, "Flakes"}, {175850, "Rule 175850"}, {194664, "Slow Blob"}}, {{195656, "Bugs"}, {239512, "Rule 239512"}, {256224, "Coagulations"}, {258752, "Day and Night"}, {261184, "Diamoeba"}}}\)

Show[
        RasterGraphics[
          InsertLines[
            2 Partition[
                Flatten[{{init}, 
                    Map[Last[
                          CellularAutomaton[{#, {2, {{2, 2, 2}, {2, 1, 
                                    2}, {2, 2, 2}}}, {1, 1}}, init, 
                            40]] &, {12, 16, 224, 746, 960, 1376, 3392, 6248, 
                        6752, 11072, 72288, 83168, 90016, 148704, 150728, 
                        174656, 174826, 175850, 194664, 195656, 239512, 
                        256224, 258752, 261184}]}, 1], 5], 1, 3, 1], 3, 
          1]];

FibonacciBinary

With[{max  =  1000}, 
        With[{seq  =  Table[Fibonacci[n], {n, 1, max}]}, 
          Show[RasterGraphics[
              Join[2 Transpose[
                    Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                      seq]], Transpose[
                  Table[IntegerDigits[n, 2, 11], {n, 1, max}]]], 3, 
              1]]]];

FourierGCD

With[{n = 512}, 
      ListDensityPlot[Abs[Fourier[Table[GCD[i, j], {i, n}, {j, n}]]], 
        ColorFunction -> Hue, Mesh -> False, 
        Frame -> False]]

FourierLCM

With[{n = 512}, 
      ListDensityPlot[Abs[Fourier[Table[1/LCM[i, j], {i, n}, {j, n}]]], 
        ColorFunction -> Hue, Mesh -> False, 
        Frame -> False]]

Page214

totalresultsRemoved  =  {{134217744, {{1, 0, 1, 
                1}, {{1, 0}}}}, {1, {{1, 0, 0, 1}, {{0}}}}};

totalresults = {{65814, {{3, 0, 2, 
                1}, {{0, 0, 0, 0, 1}}}}, {66578, {{2, 0, 2, 
                1}, {{0, 0, 0, 1}}}}, {69958, {{6, -4, 2, 
                6}, {{0, 1, 0, 0, 1, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 1, 0}, {0, 
                  0, 0, 1, 0, 0, 1, 0}, {1, 0, 0, 1, 0, 0, 0, 0}, {1, 0, 0, 
                  0, 0, 1, 0, 0}, {0, 0, 1, 0, 0, 1, 0, 0}}}}, {81922, {{3, 
                0, 3, 1}, {{0, 0, 1, 0, 0, 1}}}}, {135492, {{1, 0, 1, 
                3}, {{1, 0}, {1, 0}, {0, 0}}}}, {147456, {{2, 0, 2, 
                1}, {{1, 0, 1, 0}}}}, {201794, {{4, 0, 4, 
                3}, {{0, 1, 0, 1, 0, 1, 0, 1}, {0, 1, 0, 0, 0, 1, 0, 0}, {0, 
                  0, 0, 1, 0, 0, 0, 1}}}}, {262672, {{1, 0, 2, 
                1}, {{0, 0, 1}}}}, {332354, {{1, 0, 2, 
                2}, {{1, 0, 0}, {1, 0, 0}}}}, {397888, {{3, 0, 2, 
                1}, {{1, 0, 0, 1, 0}}}}, {1319746, {{2, 0, 2, 
                2}, {{0, 1, 0, 0}, {1, 1, 0, 0}}}}, {1384774, {{2, -1, 2, 
                3}, {{0, 0, 0, 0}, {0, 1, 0, 0}, {1, 1, 0, 
                  0}}}}, {1385794, {{3, -1, 3, 
                2}, {{0, 0, 0, 0, 1, 1}, {0, 0, 1, 0, 0, 
                  0}}}}, {1451330, {{3, 1, 2, 
                1}, {{0, 1, 0, 1, 1}, {1, 1, 0, 0, 0}}}}, {4465152, {{1, 0, 
                3, 1}, {{0, 1, 1, 0}}}}, {17111122, {{3, 0, 3, 
                3}, {{0, 1, 0, 0, 1, 0}, {0, 0, 1, 0, 0, 1}, {0, 0, 1, 0, 0, 
                  1}}}}, {17371734, {{1, 1, 3, 
                2}, {{1, 0, 1, 0}, {0, 1, 0, 0}, {0, 1, 0, 
                  0}}}}, {17373270, {{4, -1, 4, 
                2}, {{0, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 0, 1, 0, 0, 0, 
                  1}}}}, {17437268, {{4, 0, 4, 
                4}, {{0, 0, 0, 1, 0, 0, 0, 1}, {0, 1, 0, 1, 0, 1, 0, 1}, {0, 
                  0, 1, 0, 0, 0, 1, 0}, {1, 0, 1, 0, 1, 0, 1, 
                  0}}}}, {18094438, {{2, 0, 2, 
                4}, {{1, 0, 0, 1}, {0, 1, 0, 0}, {0, 1, 0, 0}, {1, 0, 0, 
                  1}}}}, {18226274, {{4, 0, 4, 
                5}, {{1, 0, 0, 1, 1, 0, 0, 1}, {0, 1, 0, 0, 0, 1, 0, 0}, {0, 
                  1, 0, 1, 0, 1, 0, 1}, {0, 0, 0, 1, 0, 0, 0, 1}, {0, 1, 1, 
                  0, 0, 1, 1, 0}}}}, {18358598, {{2, -2, 2, 
                3}, {{0, 0, 1, 1}, {0, 0, 0, 0}, {0, 1, 0, 
                  0}}}}, {18359362, {{3, -1, 2, 
                2}, {{0, 0, 0, 1, 1}, {0, 1, 0, 0, 
                  0}}}}, {18387014, {{2, -1, 2, 
                3}, {{0, 0, 0, 1}, {0, 1, 0, 0}, {1, 1, 0, 
                  0}}}}, {18625090, {{3, 0, 3, 
                4}, {{1, 1, 0, 1, 1, 0}, {0, 0, 1, 0, 0, 1}, {0, 0, 1, 0, 0, 
                  1}, {0, 1, 0, 0, 1, 0}}}}, {18637378, {{2, 0, 1, 
                3}, {{0, 1, 1}, {1, 0, 0}, {1, 0, 0}}}}, {18638930, {{1, 0, 
                2, 4}, {{0, 0, 1}, {1, 0, 0}, {1, 0, 0}, {1, 0, 
                  1}}}}, {22581798, {{4, 0, 2, 
                2}, {{0, 0, 0, 0, 1, 1}, {0, 1, 1, 0, 0, 
                  1}}}}, {34078996, {{2, 0, 2, 
                3}, {{1, 0, 1, 0}, {0, 1, 0, 1}, {0, 0, 0, 
                  0}}}}, {34082880, {{1, 0, 1, 
                2}, {{1, 0}, {0, 1}}}}, {35398994, {{3, 2, 1, 
                1}, {{0, 0, 1, 0}, {0, 1, 0, 1}, {1, 1, 0, 
                  0}}}}, {38017056, {{2, -1, 2, 
                2}, {{1, 0, 0, 1}, {0, 1, 1, 0}}}}, {38091074, {{2, -1, 
                6, 2}, {{0, 1, 1, 0, 0, 1, 0, 0}, {1, 1, 0, 1, 0, 0, 0, 
                  1}}}}, {38351652, {{3, 0, 3, 
                4}, {{1, 0, 1, 1, 0, 1}, {0, 0, 1, 0, 0, 1}, {0, 0, 0, 0, 0, 
                  0}, {1, 1, 0, 1, 1, 0}}}}, {39331108, {{3, 0, 3, 
                3}, {{1, 0, 1, 1, 0, 1}, {0, 1, 1, 0, 1, 1}, {0, 0, 0, 0, 0, 
                  0}}}}, {40163602, {{2, 0, 6, 
                2}, {{1, 0, 0, 1, 0, 1, 0, 0}, {0, 1, 1, 1, 0, 0, 0, 
                  1}}}}, {40171778, {{2, 1, 6, 
                2}, {{1, 1, 0, 1, 1, 1, 0, 0}, {1, 0, 0, 1, 0, 1, 0, 0}, {0, 
                  1, 1, 1, 0, 0, 0, 1}}}}, {43259180, {{5, 0, 5, 
                3}, {{1, 0, 0, 1, 1, 1, 0, 0, 1, 1}, {0, 1, 1, 0, 1, 0, 1, 1, 
                  0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}}}, {43267650, {{3, 
                1, 1, 2}, {{0, 0, 1, 1}, {0, 1, 0, 1}, {1, 1, 0, 
                  0}}}}, {43277346, {{2, 0, 3, 
                3}, {{1, 1, 1, 0, 0}, {0, 1, 0, 1, 1}, {0, 1, 0, 0, 
                  0}}}}, {43279658, {{1, 0, 4, 
                3}, {{1, 1, 1, 0, 0}, {0, 1, 0, 1, 1}, {0, 1, 0, 0, 
                  0}}}}, {43802950, {{3, 0, 6, 
                2}, {{1, 1, 0, 1, 0, 0, 0, 0, 1}, {1, 0, 1, 1, 0, 0, 0, 1, 
                  0}}}}, {43803666, {{1, 0, 3, 
                3}, {{1, 1, 1, 0}, {0, 1, 0, 1}, {0, 1, 0, 
                  0}}}}, {43803970, {{3, 1, 4, 
                2}, {{0, 1, 1, 1, 0, 1, 0}, {1, 0, 1, 0, 1, 1, 0}, {1, 0, 1, 
                  0, 0, 0, 0}}}}, {55056436, {{3, 1, 3, 
                1}, {{1, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 0, 
                  1}}}}, {55874154, {{2, 1, 5, 
                2}, {{1, 0, 0, 1, 1, 0, 0}, {0, 0, 1, 0, 1, 0, 0}, {0, 1, 1, 
                  0, 0, 1, 1}}}}, {56135974, {{2, 0, 1, 
                4}, {{1, 1, 0}, {1, 0, 1}, {1, 0, 0}, {0, 0, 
                  0}}}}, {56152110, {{3, 2, 4, 
                1}, {{0, 0, 1, 1, 0, 1, 0}, {1, 0, 1, 0, 1, 1, 0}, {0, 1, 1, 
                  0, 0, 1, 0}}}}, {56153142, {{3, 0, 2, 
                3}, {{0, 1, 1, 0, 1}, {1, 1, 0, 1, 0}, {0, 1, 0, 0, 
                  0}}}}, {56938506, {{2, 0, 3, 
                2}, {{0, 1, 0, 1, 0}, {1, 1, 0, 0, 1}}}}, {60043594, {{4, 2, 
                4, 1}, {{0, 0, 1, 0, 1, 1, 1, 0}, {1, 1, 1, 0, 0, 1, 0, 
                  1}, {0, 1, 0, 1, 0, 0, 0, 1}}}}, {60055562, {{1, -2, 3, 
                3}, {{1, 1, 1, 0}, {0, 1, 0, 1}, {0, 1, 0, 
                  0}}}}, {60058658, {{6, -2, 3, 
                3}, {{1, 0, 0, 1, 0, 1, 1, 1, 0}, {1, 0, 0, 1, 0, 0, 1, 0, 
                  1}, {0, 0, 1, 1, 0, 0, 1, 0, 0}}}}, {60320822, {{3, 1, 6, 
                2}, {{0, 0, 1, 1, 1, 0, 1, 0, 0}, {0, 0, 0, 1, 0, 1, 1, 0, 
                  1}, {1, 1, 0, 1, 0, 0, 0, 1, 0}}}}, {62707734, {{2, 0, 5, 
                3}, {{0, 0, 1, 0, 1, 0, 1}, {0, 0, 1, 0, 0, 1, 0}, {1, 1, 1, 
                  0, 0, 0, 1}}}}, {64251906, {{5, -2, 3, 
                3}, {{1, 0, 0, 1, 0, 1, 1, 1}, {1, 0, 0, 1, 0, 0, 1, 0}, {0, 
                  0, 1, 1, 0, 0, 1, 0}}}}, {65304582, {{3, 0, 3, 
                2}, {{0, 0, 1, 0, 1, 0}, {1, 1, 1, 0, 0, 
                  1}}}}, {102262930, {{3, 0, 3, 
                4}, {{1, 0, 0, 1, 0, 0}, {0, 1, 1, 0, 1, 1}, {0, 0, 1, 0, 0, 
                  1}, {0, 1, 1, 0, 1, 1}}}}, {102508882, {{3, 1, 4, 
                3}, {{0, 1, 0, 1, 0, 0, 0}, {0, 0, 1, 0, 1, 0, 1}, {0, 1, 1, 
                  0, 0, 1, 1}, {1, 0, 0, 0, 1, 0, 0}}}}, {106232194, {{5, 2, 
                6, 1}, {{0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 0}, {1, 1, 0, 1, 1, 0, 
                  1, 0, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 
                  0}}}}, {106467876, {{2, -1, 2, 
                3}, {{0, 0, 1, 0}, {1, 1, 0, 1}, {1, 0, 0, 
                  0}}}}, {106468652, {{1, 0, 2, 
                5}, {{1, 1, 0}, {0, 1, 0}, {1, 0, 1}, {0, 0, 0}, {1, 1, 
                  0}}}}, {107518484, {{3, 2, 5, 
                1}, {{1, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 1, 0, 1, 0, 0}, {1, 
                  0, 1, 0, 0, 0, 1, 1}}}}, {107796498, {{2, -1, 6, 
                2}, {{1, 0, 0, 1, 0, 1, 0, 1}, {0, 1, 1, 1, 0, 0, 1, 
                  0}}}}, {108323082, {{1, 0, 3, 
                3}, {{0, 1, 1, 0}, {1, 1, 0, 1}, {0, 1, 0, 
                  0}}}}, {112777238, {{2, 1, 5, 
                2}, {{0, 1, 1, 1, 1, 0, 0}, {0, 0, 1, 0, 1, 0, 1}, {1, 1, 1, 
                  0, 0, 1, 0}}}}, {122972562, {{5, 2, 6, 
                1}, {{0, 1, 1, 0, 0, 1, 0, 0, 1, 1, 0}, {1, 0, 0, 1, 1, 0, 1, 
                  0, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 
                  0}}}}, {123222150, {{2, 0, 5, 
                2}, {{1, 0, 0, 0, 1, 0, 1}, {0, 1, 1, 0, 0, 1, 
                  1}}}}, {125342342, {{3, -2, 4, 
                3}, {{1, 0, 1, 1, 1, 0, 0}, {0, 1, 1, 0, 1, 0, 1}, {0, 0, 1, 
                  0, 0, 1, 1}}}}, {125358086, {{2, -2, 4, 
                3}, {{0, 1, 1, 0, 1, 0}, {0, 0, 1, 0, 0, 1}, {1, 1, 1, 0, 0, 
                  0}}}}, {127177326, {{2, 1, 6, 
                2}, {{0, 1, 0, 0, 1, 1, 0, 0}, {1, 0, 0, 1, 0, 1, 0, 0}, {0, 
                  0, 1, 1, 0, 0, 1, 1}}}}, {129028110, {{2, 0, 4, 
                2}, {{0, 0, 1, 0, 1, 0}, {1, 1, 1, 0, 0, 
                  1}}}}, {129558550, {{1, -2, 4, 
                4}, {{0, 1, 0, 1, 0}, {1, 1, 0, 0, 1}, {0, 1, 0, 0, 0}, {1, 
                  1, 0, 1, 1}}}}, {152310376, {{3, 0, 3, 
                3}, {{1, 1, 0, 1, 1, 0}, {0, 0, 1, 0, 0, 1}, {0, 0, 1, 0, 0, 
                  1}}}}, {177484134, {{3, 3, 4, 
                1}, {{1, 1, 0, 1, 0, 1, 0}, {1, 0, 1, 0, 1, 1, 0}, {0, 1, 1, 
                  0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1}}}}, {177496358, {{3, 2, 
                5, 1}, {{0, 0, 1, 1, 1, 0, 1, 0}, {1, 1, 0, 1, 0, 1, 1, 
                  0}, {1, 0, 1, 1, 0, 0, 0, 0}}}}, {190091370, {{1, 0, 2, 
                5}, {{1, 0, 1}, {0, 1, 1}, {0, 0, 1}, {1, 0, 0}, {1, 0, 
                  0}}}}, {190107690, {{2, 0, 1, 
                4}, {{1, 1, 0}, {1, 0, 1}, {1, 0, 0}, {1, 0, 
                  0}}}}, {194286694, {{3, 3, 5, 
                1}, {{0, 1, 0, 1, 0, 1, 1, 0}, {1, 0, 1, 1, 0, 0, 1, 0}, {1, 
                  0, 0, 1, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 
                  1}}}}, {194303014, {{3, 2, 6, 
                1}, {{1, 1, 0, 1, 0, 1, 1, 0, 0}, {1, 0, 1, 1, 0, 0, 1, 0, 
                  0}, {1, 0, 0, 1, 0, 0, 0, 0, 1}}}}, {257478694, {{3, 0, 5, 
                2}, {{1, 1, 0, 1, 0, 0, 1, 0}, {1, 0, 1, 1, 0, 0, 0, 
                  1}}}}, {261132398, {{3, -1, 4, 
                5}, {{0, 0, 1, 1, 1, 0, 1}, {1, 1, 0, 1, 0, 1, 0}, {1, 0, 1, 
                  0, 1, 1, 0}, {0, 1, 1, 0, 0, 1, 0}, {0, 0, 1, 0, 0, 0, 
                  1}}}}, {261148718, {{3, 2, 5, 
                1}, {{0, 0, 1, 1, 1, 0, 1, 0}, {1, 1, 0, 1, 0, 1, 1, 0}, {1, 
                  0, 1, 1, 0, 0, 1, 0}}}}, {272703878, {{3, 0, 3, 
                2}, {{0, 1, 1, 0, 0, 0}, {0, 1, 1, 0, 0, 
                  0}}}}, {272770436, {{3, 0, 3, 
                6}, {{0, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 1, 1}, {0, 1, 1, 0, 1, 
                  1}, {0, 0, 0, 0, 0, 0}, {1, 0, 1, 1, 0, 1}, {1, 0, 1, 1, 0, 
                  1}}}}, {272998726, {{4, 2, 2, 
                1}, {{0, 0, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 
                  0}}}}, {273064262, {{2, 0, 1, 
                4}, {{0, 1, 1}, {0, 0, 0}, {1, 0, 0}, {1, 0, 
                  1}}}}, {273065282, {{3, 2, 2, 
                1}, {{0, 1, 0, 1, 1}, {1, 1, 0, 1, 1}, {1, 1, 0, 0, 
                  0}}}}, {289768238, {{2, 0, 2, 
                5}, {{0, 1, 1, 0}, {0, 0, 1, 1}, {0, 0, 0, 0}, {1, 1, 0, 
                  0}, {1, 0, 0, 1}}}}, {289834346, {{3, 2, 6, 
                1}, {{0, 1, 1, 0, 1, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 1, 1, 0, 
                  0}, {0, 0, 1, 1, 0, 0, 0, 0, 1}}}}, {289974358, {{6, 0, 2, 
                2}, {{1, 1, 0, 1, 0, 0, 1, 0}, {0, 0, 1, 1, 0, 0, 0, 
                  1}}}}, {289974470, {{5, -2, 2, 
                4}, {{1, 0, 0, 0, 1, 1, 0}, {1, 0, 1, 0, 0, 1, 1}, {0, 1, 1, 
                  0, 0, 0, 1}, {0, 1, 1, 0, 1, 0, 
                  0}}}}, {289974838, {{6, -1, 2, 
                3}, {{1, 1, 0, 0, 1, 0, 0, 1}, {1, 0, 0, 0, 0, 1, 0, 1}, {1, 
                  0, 1, 1, 0, 0, 1, 0}}}}, {289974950, {{5, -3, 2, 
                5}, {{0, 0, 1, 1, 0, 1, 1}, {1, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 
                  0, 1, 1, 0}, {0, 1, 1, 0, 0, 1, 1}, {1, 1, 0, 0, 0, 0, 
                  1}}}}, {290009798, {{5, 0, 5, 
                4}, {{0, 1, 1, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 1, 0, 1, 0, 0, 1, 
                  0, 1}, {0, 0, 0, 1, 1, 0, 0, 0, 1, 1}, {0, 1, 0, 1, 0, 0, 
                  1, 0, 1, 0}}}}, {290033734, {{4, 2, 2, 
                1}, {{1, 0, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 
                  0}}}}, {290034358, {{5, 3, 3, 
                1}, {{0, 1, 1, 0, 0, 1, 1, 0}, {1, 1, 0, 0, 0, 1, 1, 0}, {1, 
                  1, 0, 1, 0, 0, 1, 1}, {0, 1, 1, 0, 0, 0, 0, 
                  1}}}}, {290035862, {{3, 0, 6, 
                2}, {{0, 0, 1, 1, 0, 0, 1, 0, 1}, {0, 0, 1, 1, 0, 0, 0, 1, 
                  0}}}}, {290038086, {{3, -1, 2, 
                3}, {{0, 0, 0, 1, 1}, {0, 1, 0, 0, 0}, {1, 1, 0, 0, 
                  0}}}}, {290038566, {{6, 1, 2, 
                1}, {{1, 0, 0, 0, 0, 1, 1, 0}, {1, 0, 1, 1, 0, 0, 0, 
                  1}}}}, {290098358, {{2, 0, 3, 
                3}, {{1, 0, 1, 1, 0}, {0, 0, 0, 1, 1}, {1, 1, 0, 0, 
                  0}}}}, {290099270, {{3, 1, 2, 
                2}, {{0, 1, 0, 1, 1}, {1, 1, 0, 0, 1}, {1, 1, 0, 0, 
                  0}}}}, {290099894, {{4, 2, 3, 
                2}, {{1, 1, 0, 1, 1, 0, 1}, {1, 0, 0, 0, 1, 1, 0}, {1, 0, 1, 
                  0, 0, 1, 0}, {1, 1, 0, 0, 0, 0, 
                  1}}}}, {290101398, {{2, -2, 5, 
                3}, {{1, 0, 0, 0, 1, 0, 1}, {0, 1, 1, 0, 0, 1, 0}, {0, 1, 1, 
                  0, 0, 0, 1}}}}, {290104868, {{4, 0, 2, 
                2}, {{0, 1, 1, 0, 1, 1}, {1, 1, 0, 0, 0, 
                  0}}}}, {290732486, {{4, 0, 4, 
                6}, {{1, 0, 0, 1, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 1, 1, 0}, {0, 
                  0, 1, 1, 0, 0, 1, 1}, {0, 0, 0, 1, 0, 0, 0, 1}, {0, 1, 0, 
                  0, 0, 1, 0, 0}, {1, 1, 0, 0, 1, 1, 0, 
                  0}}}}, {291279468, {{6, -1, 2, 
                3}, {{1, 0, 0, 0, 1, 1, 0, 0}, {1, 0, 1, 1, 0, 0, 1, 0}, {0, 
                  1, 1, 0, 0, 0, 1, 1}}}}, {292080182, {{5, -2, 2, 
                4}, {{1, 0, 0, 1, 0, 0, 1}, {0, 0, 0, 0, 1, 0, 1}, {0, 1, 1, 
                  0, 0, 1, 0}, {1, 1, 0, 0, 0, 0, 
                  1}}}}, {292080294, {{6, -2, 2, 
                4}, {{1, 1, 0, 0, 1, 1, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 0}, {1, 
                  0, 1, 1, 0, 0, 1, 1}, {1, 1, 1, 0, 0, 0, 0, 
                  1}}}}, {293636134, {{3, -1, 2, 
                3}, {{0, 0, 1, 1, 0}, {0, 0, 0, 1, 1}, {1, 1, 0, 0, 
                  1}}}}, {293906502, {{6, 1, 2, 
                1}, {{1, 0, 0, 1, 0, 0, 1, 1}, {1, 1, 1, 1, 0, 0, 0, 
                  1}}}}, {294819366, {{4, 0, 4, 
                2}, {{0, 0, 0, 0, 0, 1, 1, 0}, {1, 1, 1, 1, 0, 0, 1, 
                  0}}}}, {295213206, {{5, -1, 4, 
                5}, {{0, 1, 0, 0, 1, 1, 1, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 0, 
                  0}, {0, 1, 1, 1, 0, 0, 1, 0, 1}, {0, 0, 1, 1, 0, 0, 0, 1, 
                  0}, {0, 0, 0, 1, 0, 1, 0, 0, 1}}}}, {306742564, {{2, 0, 1, 
                5}, {{0, 1, 1}, {0, 1, 1}, {1, 0, 1}, {0, 0, 0}, {1, 1, 
                  0}}}}, {307004786, {{2, -1, 4, 
                3}, {{0, 0, 0, 1, 1, 0}, {1, 0, 1, 0, 1, 1}, {0, 1, 1, 0, 0, 
                  0}}}}, {307011942, {{2, 0, 1, 
                6}, {{1, 1, 0}, {0, 1, 1}, {0, 0, 0}, {1, 0, 0}, {1, 0, 
                  1}, {0, 1, 1}}}}, {307134822, {{1, 0, 2, 
                5}, {{1, 1, 0}, {0, 1, 1}, {0, 0, 0}, {1, 0, 0}, {1, 0, 
                  1}}}}, {310649160, {{4, 0, 4, 
                2}, {{1, 0, 0, 1, 0, 1, 1, 0}, {1, 1, 1, 1, 0, 0, 0, 
                  0}}}}, {310783442, {{3, 2, 6, 
                1}, {{0, 1, 0, 0, 1, 1, 1, 0, 1}, {0, 1, 1, 1, 0, 1, 1, 0, 
                  0}, {1, 0, 1, 1, 0, 0, 0, 0, 
                  1}}}}, {310976876, {{6, -2, 6, 
                3}, {{0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 
                  0, 0, 1, 1, 0, 1}, {1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
                  0}}}}, {311141734, {{6, 0, 6, 
                2}, {{0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 1, 1, 
                  0, 0, 0, 1, 0, 1}}}}, {311176658, {{3, 3, 5, 
                1}, {{0, 1, 0, 0, 1, 1, 1, 0}, {0, 1, 1, 1, 0, 1, 1, 0}, {1, 
                  0, 1, 1, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 1, 0, 
                  1}}}}, {311338306, {{3, 0, 4, 
                2}, {{1, 0, 1, 0, 1, 1, 0}, {1, 1, 1, 0, 0, 0, 
                  0}}}}, {311697798, {{3, 2, 3, 
                1}, {{0, 0, 0, 1, 1, 1}, {1, 1, 1, 0, 1, 1}, {0, 1, 1, 0, 0, 
                  0}}}}, {311698732, {{6, 0, 6, 
                3}, {{1, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1}, {0, 1, 1, 0, 1, 1, 
                  0, 1, 1, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
                  0}}}}, {311730502, {{3, 0, 4, 
                2}, {{1, 1, 1, 0, 0, 0, 0}, {0, 1, 1, 0, 0, 0, 
                  1}}}}, {311731522, {{3, 1, 2, 
                2}, {{0, 0, 1, 1, 1}, {0, 1, 0, 1, 1}, {1, 1, 0, 0, 
                  0}}}}, {312225124, {{3, -1, 4, 
                3}, {{0, 0, 0, 1, 1, 1, 1}, {0, 1, 1, 0, 1, 1, 0}, {1, 0, 0, 
                  0, 0, 0, 0}}}}, {312240466, {{4, 0, 4, 
                6}, {{1, 0, 1, 0, 1, 0, 1, 0}, {1, 0, 1, 1, 1, 0, 1, 1}, {0, 
                  1, 0, 1, 0, 1, 0, 1}, {0, 0, 0, 1, 0, 0, 0, 1}, {0, 0, 1, 
                  1, 0, 0, 1, 1}, {0, 1, 0, 0, 0, 1, 0, 
                  0}}}}, {312263982, {{5, 0, 3, 
                3}, {{1, 0, 1, 1, 1, 0, 0, 1}, {1, 1, 0, 1, 0, 1, 1, 0}, {0, 
                  0, 0, 1, 0, 0, 0, 0}}}}, {312271186, {{3, 0, 1, 
                5}, {{1, 0, 1, 0}, {1, 1, 1, 0}, {0, 1, 0, 1}, {0, 1, 0, 
                  0}, {1, 1, 0, 0}}}}, {314911014, {{4, -3, 3, 
                4}, {{0, 0, 0, 1, 1, 0, 1}, {0, 0, 0, 0, 0, 0, 1}, {0, 1, 1, 
                  0, 0, 0, 0}, {1, 1, 0, 0, 1, 1, 
                  0}}}}, {314912066, {{5, -3, 3, 
                4}, {{0, 0, 1, 1, 0, 1, 1, 1}, {1, 0, 0, 0, 0, 1, 1, 0}, {1, 
                  0, 0, 1, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 1, 
                  0}}}}, {315172404, {{4, 2, 1, 
                1}, {{1, 1, 1, 0, 1}, {1, 1, 0, 1, 0}, {0, 0, 0, 0, 
                  0}}}}, {315174246, {{4, 2, 6, 
                1}, {{1, 1, 1, 0, 1, 1, 0, 1, 0, 0}, {1, 1, 0, 1, 0, 0, 0, 1, 
                  1, 0}, {0, 0, 0, 1, 1, 0, 0, 0, 0, 
                  0}}}}, {315212076, {{5, -3, 3, 
                4}, {{0, 0, 0, 1, 1, 0, 1, 0}, {0, 0, 0, 0, 0, 0, 1, 1}, {1, 
                  1, 1, 0, 0, 0, 0, 0}, {1, 1, 0, 1, 1, 1, 0, 
                  0}}}}, {323786902, {{1, 0, 3, 
                4}, {{0, 0, 0, 1}, {1, 1, 0, 0}, {1, 1, 0, 0}, {0, 1, 0, 
                  1}}}}, {323791270, {{4, 0, 4, 
                4}, {{1, 1, 0, 0, 0, 1, 1, 0}, {1, 0, 1, 1, 0, 0, 0, 1}, {1, 
                  0, 1, 1, 0, 0, 0, 1}, {1, 1, 0, 0, 0, 1, 1, 
                  0}}}}, {323799090, {{2, 0, 2, 
                6}, {{0, 1, 1, 0}, {0, 1, 0, 1}, {1, 1, 0, 0}, {1, 1, 0, 
                  0}, {0, 1, 0, 1}, {0, 1, 1, 0}}}}, {328494146, {{2, 0, 4, 
                4}, {{1, 0, 0, 1, 1, 1}, {0, 0, 1, 0, 1, 1}, {1, 1, 1, 0, 0, 
                  0}, {0, 1, 0, 0, 1, 0}}}}, {328762534, {{2, -2, 4, 
                3}, {{1, 1, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1}, {1, 1, 1, 0, 0, 
                  0}}}}, {328766598, {{5, -2, 4, 
                3}, {{0, 1, 0, 0, 1, 1, 0, 1, 1}, {0, 0, 0, 0, 0, 1, 0, 0, 
                  1}, {0, 1, 1, 1, 0, 0, 0, 0, 
                  0}}}}, {328767030, {{3, -1, 4, 
                3}, {{0, 1, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 1}, {1, 1, 1, 
                  0, 0, 1, 0}}}}, {328778790, {{3, 1, 4, 
                3}, {{0, 1, 1, 0, 1, 1, 0}, {0, 0, 1, 0, 0, 1, 1}, {1, 0, 1, 
                  0, 0, 0, 0}, {0, 1, 1, 0, 1, 1, 1}}}}, {329050134, {{6, 0, 
                5, 2}, {{0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1}, {1, 0, 0, 0, 1, 0, 
                  0, 0, 1, 1, 0}}}}, {330066002, {{4, 0, 1, 
                5}, {{1, 1, 1, 0, 1}, {0, 1, 0, 1, 0}, {0, 1, 0, 0, 1}, {1, 
                  1, 0, 0, 1}, {1, 0, 0, 1, 0}}}}, {331924534, {{5, 2, 2, 
                1}, {{1, 0, 1, 1, 0, 1, 1}, {1, 1, 1, 0, 1, 0, 1}, {0, 1, 1, 
                  0, 0, 0, 0}}}}, {334010518, {{4, 5, 7, 
                1}, {{1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1}, {0, 1, 1, 0, 0, 0, 1, 
                  1, 1, 0, 0}, {0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0}, {1, 0, 0, 
                  1, 1, 0, 0, 0, 1, 0, 1}, {1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 
                  0}, {1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1}}}}, {334288918, {{3, 
                2, 5, 2}, {{0, 0, 0, 1, 0, 1, 1, 0}, {1, 1, 1, 1, 0, 0, 1, 
                  0}, {1, 0, 1, 1, 0, 0, 0, 1}, {1, 0, 0, 1, 0, 1, 0, 
                  0}}}}, {373916010, {{2, -2, 4, 
                3}, {{1, 1, 0, 1, 1, 0}, {0, 0, 1, 0, 1, 1}, {0, 1, 1, 0, 0, 
                  0}}}}, {373916076, {{5, 0, 5, 
                2}, {{1, 1, 0, 1, 1, 0, 1, 1, 0, 0}, {1, 1, 0, 0, 0, 0, 0, 1, 
                  1, 0}}}}, {373917112, {{1, 0, 5, 
                3}, {{1, 0, 0, 1, 1, 0}, {0, 1, 1, 0, 1, 1}, {0, 1, 1, 0, 0, 
                  0}}}}, {373918136, {{1, -1, 6, 
                3}, {{1, 0, 0, 1, 1, 0, 1}, {0, 1, 1, 0, 1, 1, 0}, {0, 1, 1, 
                  0, 0, 0, 1}}}}, {373918388, {{5, 0, 5, 
                2}, {{1, 1, 0, 0, 1, 0, 1, 1, 0, 0}, {1, 1, 0, 1, 0, 0, 0, 1, 
                  1, 0}}}}, {373987748, {{4, -1, 4, 
                3}, {{0, 0, 0, 0, 1, 1, 0, 1}, {1, 0, 1, 1, 0, 1, 0, 1}, {1, 
                  0, 1, 0, 0, 0, 0, 0}}}}, {373991844, {{3, 0, 3, 
                5}, {{1, 0, 1, 1, 0, 1}, {0, 0, 0, 1, 1, 0}, {0, 1, 1, 0, 1, 
                  1}, {1, 1, 0, 0, 0, 0}, {1, 0, 1, 1, 0, 
                  1}}}}, {374114744, {{2, 1, 5, 
                2}, {{1, 0, 0, 1, 1, 0, 0}, {0, 1, 1, 0, 1, 1, 0}, {0, 1, 1, 
                  0, 0, 0, 1}}}}, {374122834, {{4, 0, 5, 
                2}, {{1, 0, 1, 1, 0, 1, 0, 0, 0}, {1, 0, 1, 1, 0, 0, 1, 0, 
                  1}}}}, {375100806, {{4, -2, 6, 
                3}, {{1, 0, 1, 1, 0, 1, 1, 0, 0, 0}, {0, 0, 0, 1, 1, 0, 1, 0, 
                  1, 1}, {0, 1, 1, 0, 1, 0, 0, 0, 0, 1}}}}, {376228178, {{2, 
                0, 4, 4}, {{1, 0, 1, 1, 1, 0}, {1, 0, 1, 0, 1, 1}, {1, 1, 1, 
                  0, 0, 0}, {0, 0, 1, 0, 0, 1}}}}, {378638726, {{2, -1, 
                6, 2}, {{0, 0, 1, 1, 0, 0, 0, 1}, {1, 1, 0, 1, 0, 0, 0, 
                  0}}}}, {394823830, {{4, -3, 3, 
                6}, {{0, 0, 1, 1, 0, 0, 0}, {0, 1, 0, 1, 1, 1, 0}, {1, 0, 0, 
                  0, 1, 1, 0}, {1, 1, 1, 0, 0, 1, 1}, {0, 1, 1, 0, 1, 0, 
                  1}, {1, 0, 1, 1, 0, 0, 0}}}}, {395358286, {{4, -2, 4, 
                3}, {{0, 1, 1, 0, 1, 1, 1, 1}, {0, 0, 1, 0, 0, 1, 1, 0}, {0, 
                  0, 0, 1, 0, 0, 1, 0}}}}, {428057710, {{5, 3, 6, 
                1}, {{1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 0}, {0, 1, 1, 0, 1, 0, 0, 
                  1, 1, 1, 0}, {0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 
                  1, 1, 0, 1, 0, 0, 0, 0}}}}, {429441830, {{6, 0, 3, 
                2}, {{0, 0, 0, 0, 0, 1, 1, 0, 1}, {0, 1, 1, 1, 0, 0, 0, 1, 
                  1}}}}, {511809130, {{5, 3, 3, 
                1}, {{0, 0, 1, 1, 0, 1, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 1}, {1, 
                  1, 1, 1, 0, 0, 1, 1}, {0, 1, 1, 0, 0, 1, 0, 
                  1}}}}, {511816044, {{3, 2, 5, 
                2}, {{0, 1, 0, 1, 0, 1, 0, 0}, {1, 1, 0, 0, 0, 1, 1, 1}, {1, 
                  0, 1, 0, 0, 0, 1, 1}, {0, 0, 1, 1, 1, 1, 0, 
                  1}}}}, {545259780, {{1, 0, 1, 
                4}, {{1, 1}, {0, 0}, {0, 0}, {1, 
                  1}}}}, {616635046, {{6, -1, 6, 
                2}, {{0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 1, 1, 1, 1, 
                  0, 0, 1, 1, 0, 0}}}}};

utahcoordinates[{u1_, u2_, u3_, u4_}, {p1_, 
          p2_}] := (SetPrecision[#1 - Floor[#1], 
              4] &) /@ {(p1/u1) + ((u3 (-(p2 u1) + p1 u4))/(u1 (u1 (-u2 - u4) - u3 u4))), -((-(p2 u1) + 
                  p1 u4)/(u1 (-u2 - u4) - 
                  u3 u4))}

fillrect[utahinfo_, {ylen_, xlen_}] := 
      Reverse@Transpose[
          Module[{utah, filler}, 
            utah = utahinfo[[1]]; 
            filler = utahinfo[[2]]; 
            filler = 
              Flatten[MapIndexed[
                  utahcoordinates[utah, Reverse[#2]] -> #1 &, 
                  Reverse[filler], {2}], 1]; 
            Table[utahcoordinates[utah, {xind, yind}], {yind, ylen, 
                  1, -1}, {xind, 1, xlen}] /. filler]]

Show[
      RasterGraphics[
        InsertLines[
          Partition[
            Map[InsertLines[{{InsertLines[{{#}}, 1, 1, 5]}}, 6, 6, 0] &, 
              Map[InsertLines[ 
                    fillrect[#[[2]], {20, 20}] /. {1 -> 
                          Table[4, {5}, {5}], 0 -> Table[0, {5}, {5}]}, 
                    1, 0, 3] &, totalresults]], 13], 1, 1, 0], 5, 
        1]]

Page452

CA2EvolveList[rule_List, {a_List, b_List}, t_Integer] := 
      Map[First, NestList[CA2Step[rule, #] &, {a, b}, t]]
CA2Step[rule_List, {a_, b_}] := {b, 
        Mod[a + rule[[8 - (RotateLeft[b] + 
                    2 (b + 2 RotateRight[b]))]], 
          2]}

Show[
        RasterGraphics[
InsertLines[{{InsertLines[{Map[
                      2 CA2EvolveList[
                            IntegerDigits[#, 2, 
                              8], {PadLeft[
                                Table[Random[Integer, {0, 1}], {14}], 100, 0, 
                                43], PadLeft[
                                Table[Random[Integer, {0, 1}], {14}], 100, 0, 
                                43]}, 931]  &, {0, 26, 37, 73, 90, 122, 173, 
                        214, 222}] }, 4, 4, 1]}}, 2, 2, 2], 3, 
          1]];

Page583-1082

L2DEvolve[rules_List, state_List] := 
      Flatten[Map[Flatten, Transpose[state /. rules, {1, 3, 2}], {2}], 
        1]

L2DEvolve[rules_List, state_List, n_Integer] := 
      Nest[L2DEvolve[rules, #1] &, state, n]

Tuples[m_, k_:  2] := 
      Table[IntegerDigits[i, k, m], {i, k^m - 1, 0, -1}]

allrules = Partition[#, 2] & /@ Partition[#, 4] & /@ 
          Tuples[8];

gr1  =  
        Map[L2DEvolve[{1 -> First[#], 0 -> Last[#]}, {{1}}, 8] &, 
          allrules[[{106, 158, 24, 242, 227, 27, 181, 
                80}]]];

gr2  =  
        Map[With[{temp  = 
                  Log[Log[
                        Log[Abs[
                                Fourier[
                                  L2DEvolve[{1 -> First[#], 
                                      0 -> Last[#]}, {{1}}, 8]]] + 1] + 
                          1] + 1]},  Floor[256 temp/Max[temp]]] &, 
          allrules[[{106, 158, 24, 242, 227, 27, 181, 
                80}]]];

gr  =  Flatten[{250 gr1,  gr2}, 1];

Show[
      RasterGraphics[
        InsertLines[
          Partition[
            Map[InsertLines[{{InsertLines[{{#}}, 4, 4, 0]}}, 1, 1, 256] &, 
              gr], 4], 5, 5, 0], 256, 1]]

Page696

Show[
        RasterGraphics[
InsertLines[{{InsertLines[{{2 CellularAutomaton[54, Table[Random[Integer, {0, 1}], {500}], 
                          245]}, 
{Map[
                        Apply[Plus, Transpose[Partition[#, 2]]] &, 
                        Map[Last, 
                          Partition[
                            CellularAutomaton[54, 
                              Table[Random[Integer, {0, 1}], {1000}], 491], 
                            2]]]}}, 4, 4, 0]}}, 2, 2, 2], 3, 
          1]];

Page747

gr = 
        MapIndexed[
          Table[With[{dx = IntegerDigits[x, 2, 7], 
                  dy = IntegerDigits[y, 2, 7]}, ReleaseHold[#]], {y, 
                255}, {x, 255}] &, {{HoldForm[
                If[Mod[Log[x y], 1] > 1/2, 1, 0]], 
              HoldForm[If[Mod[Sqrt[x y], 1] > 1/2, 1, 0]], 
              HoldForm[If[Mod[Sin[x y], 1] > 1/2, 1, 0]],  
              HoldForm[If[Mod[Sin[x] + Sin[y], 1] > 1/2, 1, 0]]}, {Mod[
                Quotient[y, x], 2], Mod[Quotient[y^3, x^2], 2], 
              Mod[Quotient[2^y, x], 2], 
              Mod[Quotient[3^y, 2^x], 2]}, {Mod[Mod[y, x], 2], 
              Mod[Binomial[y, x], 2], 
              HoldForm[Mod[DigitCount[x  y,  2,  1], 2]], 
              If[GCD[y,  x] == 1, 1, 0]}, {HoldForm[
                Mod[dx . dy, 2]], 
              HoldForm[If[Count[dy - dx, 1] == 1, 1, 0]], 
              HoldForm[If[Count[dy - dx, 0] == 3, 1, 0]], 
              HoldForm[If[Count[dy - dx, 0] > 3, 1, 0]]}}, {2}];

Show[
      RasterGraphics[
        InsertLines[
          Partition[
            Map[InsertLines[{{InsertLines[{{#}}, 4, 4, 0]}}, 1, 1, 2] &, 
              Flatten[2 gr, 1]], 4], 5, 5, 0], 3, 1]]

Page984

ContourPlot[
        Plus @@ Sin /@ 
            Table[Cos[((2 π i)/5)] x + 
                Sin[((2 π i)/5)] y, {i, 0, 5 - 1}], {x, -60, 
          60}, {y, -60, 60}, PlotPoints -> 500, 
        Frame ->  False];

Page1035

MazRules = {{1, 1, 1} -> 1, {1, 1, 2} -> 
            2, {1, 1, 3} -> 1, {1, 1, 4} -> 4, {1, 1, 5} -> 
            3, {1, 2, 2} -> 2, {1, 2, 3} -> 3, {1, 2, 5} -> 
            2, {1, 3, 1} -> 3, {1, 3, 2} -> 3, {1, 3, 3} -> 
            3, {1, 3, 5} -> 1, {1, 3, 6} -> 3, {1, 4, 1} -> 
            3, {1, 4, 2} -> 2, {1, 4, 3} -> 2, {1, 4, 5} -> 
            3, {1, 4, 6} -> 2, {1, 5, 1} -> 5, {1, 5, 2} -> 
            5, {1, 5, 3} -> 5, {1, 5, 4} -> 5, {1, 5, 5} -> 
            5, {1, 5, 6} -> 5, {2, 1, 3} -> 5, {2, 1, 4} -> 
            4, {2, 1, 5} -> 5, {2, 1, 6} -> 5, {2, 2, 1} -> 
            1, {2, 2, 2} -> 2, {2, 2, 3} -> 1, {2, 2, 4} -> 
            4, {2, 2, 5} -> 2, {2, 3, 1} -> 3, {2, 3, 2} -> 
            3, {2, 3, 3} -> 4, {2, 3, 5} -> 4, {2, 3, 6} -> 
            4, {2, 4, 4} -> 4, {2, 4, 5} -> 4, {2, 5, 1} -> 
            5, {2, 5, 2} -> 5, {2, 5, 3} -> 3, {2, 5, 4} -> 
            5, {2, 5, 5} -> 4, {2, 5, 6} -> 3, {3, 1, 2} -> 
            1, {3, 1, 3} -> 3, {3, 1, 4} -> 2, {3, 1, 5} -> 
            2, {3, 2, 1} -> 1, {3, 2, 3} -> 1, {3, 2, 5} -> 
            1, {3, 3, 1} -> 3, {3, 3, 2} -> 3, {3, 3, 3} -> 
            7, {3, 3, 5} -> 1, {3, 3, 6} -> 7, {3, 4, 2} -> 
            2, {3, 4, 3} -> 2, {3, 5, 1} -> 5, {3, 5, 2} -> 
            5, {3, 5, 3} -> 4, {3, 5, 4} -> 5, {3, 5, 5} -> 
            2, {4, 1, 1} -> 1, {4, 1, 2} -> 5, {4, 1, 4} -> 
            1, {4, 1, 5} -> 3, {4, 2, 1} -> 1, {4, 2, 3} -> 
            1, {4, 2, 5} -> 1, {4, 2, 6} -> 1, {4, 3, 1} -> 
            3, {4, 3, 2} -> 3, {4, 3, 5} -> 1, {4, 4, 1} -> 
            1, {4, 4, 2} -> 2, {4, 4, 3} -> 1, {4, 4, 4} -> 
            4, {4, 4, 5} -> 4, {4, 5, 1} -> 5, {4, 5, 2} -> 
            5, {4, 5, 3} -> 2, {4, 5, 4} -> 5, {4, 5, 5} -> 
            3, {4, 5, 6} -> 2, {5, 1, 1} -> 1, {5, 1, 2} -> 
            5, {5, 1, 3} -> 1, {5, 1, 4} -> 3, {5, 2, 1} -> 
            3, {5, 2, 2} -> 2, {5, 2, 3} -> 3, {5, 2, 4} -> 
            4, {5, 2, 5} -> 2, {5, 3, 1} -> 3, {5, 3, 2} -> 
            3, {5, 3, 4} -> 3, {5, 4, 1} -> 5, {5, 4, 2} -> 
            3, {5, 4, 4} -> 4, {5, 5, 1} -> 5, {5, 5, 2} -> 
            5, {5, 5, 3} -> 5, {5, 5, 5} -> 5, {5, 5, 6} -> 
            5, {6, 3, 1} -> 3, {6, 3, 2} -> 3, {6, 3, 3} -> 
            7, {6, 3, 5} -> 4, {6, 4, 2} -> 3, {3, 1, 6} -> 
            3, {3, 2, 6} -> 1, {3, 4, 6} -> 2, {3, 5, 6} -> 
            4, {1, 2, 6} -> 3};

MazStep[l_] := 
      Flatten[{6, Partition[l, 3, 1] /. 
              MazRules /. {a_, b_, 
                c_} :> (If[! MemberQ[{a, b, c}, 8], 
                  Print["No rule for ", {a, b, c}]]; 8), 6}]

MazInit[n_] := Flatten[{6, 3, Table[5, {n - 1}], 6}]

MazRun[n_] := NestList[MazStep, MazInit[n], 2  n - 2]

Dimensions[MazRun[502]]

Dimensions[MazRun[102]]

Show[
        RasterGraphics[
InsertLines[{{InsertLines[{{
PadLeft[MazRun[500], {1005, 506}, 
                        0, {3, 2}], 
PadLeft[
                        MazRun[502], {1005, 506}, 0, {1, 1}]}}, 4, 4, 0]}}, 
            2, 2, 7], 8, 1]];

ThreeColorCAs

Various three-color CA rules picked out by NKS Summer School students.

CA3col  =  
        Map[CellularAutomaton[{#, 3, 1}, {{1}, 0}, 
              300,  {All, All}] &, {26718, 156618, 200013, 922461, 6999927, 
            34988764, 84705105000, 219449870097, 223983578902, 255643640409, 
            434501270529, 456450848782, 542331049287, 666880135392, 
            776233778217, 1220959765302, 1356863959458, 1450408494138, 
            1556002847247, 1859893720908, 2523185237382, 2528808764523, 
            3245683148729, 3751983728567, 4281159927647, 5049357248562, 
            5630093453638, 6089974404181, 6482847025299, 6573308143885, 
            6581808479559, 6754441059772, 7049556986191}];

Show[
      RasterGraphics[
        InsertLines[
          Partition[
            Map[InsertLines[{{InsertLines[{{#}}, 4, 4, 0]}}, 1, 1, 2] &, 
              CA3col], 4], 5, 5, 0], 3, 1]]

Transparent3DCenterFace

With[{gg = 
          Partition[
            Map[Apply[Plus, 
                  Last[CellularAutomaton[{#, {2, center + face}, {1, 1, 
                          1}}, {{{{1}}}, 0}, 40, {All, All, All}]]] &, {2, 6, 
                14, 18, 22, 26, 30, 38, 46, 50, 54, 58, 62, 65, 66, 69, 70, 
                73, 77, 78, 81, 82, 86, 89, 90, 93, 94, 97, 98, 101, 102, 
                105, 106, 109, 110, 113, 114, 117, 118, 121, 122, 125, 126, 
                129, 133, 134, 137, 141, 145, 146, 149, 153, 154, 157, 158, 
                161, 165, 166, 169, 173, 174, 177, 181, 182, 185, 186, 194, 
                198, 202, 206, 210, 214, 218, 230, 234, 238, 242, 246, 250, 
                250, 250}], 9]}, 
      Show[RasterGraphics[InsertLines[gg, 1, 3, 1], Max[gg] + 1, 
          1]]]

Images for NKS 2004
by Michael Schreiber

Vienna, 2004 March (29^th)Version 0.2 by Michael@Schreiber.at

Abstract

This updated notebook features three poster art contributions to the NKS 2004. Some generic functions are introduced first. The first poster uses Gray coding to initialize integer Random. The second project illustrates a nonstandard interpretatation of elementary rules in space. An optimized function for binary DeBruijn sequences is used in the third poster section, which composes rules like an oracle.

Common

Artinit context

Begin["Artinit`"];

Customized standard code

Lines between Raster objects

The above program takes potential raster data and adds the appropriate numbers in between to form a new raster.   (Quoted from the notebook sent by Ed Pegg Jr.)

The below version is compatible and supports ColorFunction for meshed data in general and RGBColor in particular.

myInsertLines[datain_, numint_ : 1, numext_ : 1, 
        insertin_ : Automatic] := 
      Module[{data = datain, numx, ny, inserted}, {ny, numx} = 
          Take[Dimensions[data], 2]; 
        inserted = If[insertin === Automatic, Max[data] + 1, insertin]; 
        data = Flatten[Map[Flatten[#, 1] &, Transpose /@ data, {2}], 1]; 
        data = Insert[data, Table[inserted, {Length[data[[1]]]}], 
            Flatten[Table[
                If[i == 1 || i == Length[data] + 1, 
                  Table[{i}, {numext}], Table[{i}, {numint}]], {i, 1, 
                  Length[data] + 1, Length[data]/ny}], 1]]; 
        data = Transpose[
            Insert[Transpose[data], 
              Table[inserted, {Length[data]}], 
   
              rr  =     
Flatten[
                  Table[If[
                      i == 1 || i == Length[data[[1]]] + 1, 
                      Table[{i}, {numext}], Table[{i}, {numint}]], {i, 1, 
                      Length[data[[1]]] + 1, 
                      Length[data[[1]]]/numx}], 1]]]]

RasterGraphics—Perfected

The above program makes images that look perfect on the screen.  These objects can then be passed to the program used to print the posters, without having the art distorted.  This is of utmost importance.  Anything that doesn't look good on the screen must be reprocessed.  (Quoted from the notebook sent by Ed Pegg Jr.)

myRasterGraphics[state_, colors_:  2, size_:  1] := 
      With[{dim = Dimensions[state]}, 
        Graphics[
          If[Length[dim] == 3, 
            Raster[Reverse[state/(colors - 1)], 
              ColorFunction -> RGBColor], 
            Raster[Reverse[1 - state/(colors - 1)]]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, dim[[2]]}, {0, dim[[1]]}}, 
          ImageSize -> 
            size*{dim[[2]], dim[[1]]} + 1]]

The above program recognizes states for RGBColor and is compatible. 
The below version of this function is incompatible but avoids export distortions on my system.

exRasterGraphics[state_, colors_:  2, size_:  1] := 
      With[{dim = Dimensions[state]}, 
        Graphics[
          If[Length[dim] == 3, 
            Raster[Reverse[state/(colors - 1)], 
              ColorFunction -> RGBColor], 
            Raster[Reverse[1 - state/(colors - 1)]]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, dim[[2]]}, {0, dim[[1]]}}, 
          ImageSize -> size*{dim[[2]], dim[[1]]}]]

Generic functions

Binary DeBruijn sequences

itlimit := 
      If[$IterationLimit == Infinity, $IterationLimit = 
          old$IterationLimit; Clear[f, old$IterationLimit]; $IterationLimit, 
        old$IterationLimit = $IterationLimit; $IterationLimit = Infinity]; 
    SetAttributes[dbflat, Flat];
bitDeBruijn[k_] := 
        bitDeBruijn[dbflat @@ (0 & /@ Range[k]), 
          dbflat @@ Append[0 & /@ Range[k - 1], 1], 2^k];
bitDeBruijn[L_, k_, M_] := 
        If[Length[L] > M, Take[List @@ L, M], 
          If[MemberQ[L /. k -> "W", "W"], 
            bitDeBruijn[Append[L, 0], 
              Append[Take[k, {2, -2}], dbflat[0, 1]], M], 
            bitDeBruijn[Append[L, 1], Append[Drop[k, 1], 1], 
              M]]];
testDeBruijn[x_, fun_] := 
        Timing[With[{d = fun[x], m = 2^x}, 
            With[{L = Length[d]}, {m == 
                  Length[Union[
                      Sort[Table[
                          FromDigits[Take[RotateLeft[Take[d, m], r], x], 
                            2], {r, 0, L - 1}]]]], d}]]];

The functions above generate and test binary DeBruijn sequences more quickly than the general DeBruijnSequence function in the Combinatorica package by Steven Skiena.

itlimit

itlimit toggles the iteration limit of Mathematica between your original settings and infinity.

itlimit

The numeric input is interpreted as an exponent of two, which defines the length of the DeBruijn sequence. 12 returns 4096 bits, which covers all binary words with 12 letters chosen from the alphabet {0,1}.

Timing[db12 = bitDeBruijn[12];]

Binary Gray codes

gray[n_, 2, 
        digits_] := {0, 1, 1, 
              0}[[Floor[Mod[n/(2^(digits - #)), 4]] + 1]] & /@ 
        Range[digits]

The above function for Gray codes is used to make a table of values below.

gray12 = gray[#, 2, 12] & /@ 
          Range[0, -1 + 2^12];

gray[n_, 2, 12] := gray12[[n + 1]];

Reordered sampling

ordersample[samplingfunction_, enumerationfunction_, p1_, p2_] := 
        Table[samplingfunction[enumerationfunction[x], 
            enumerationfunction[y]], {y, p1[[2]], p2[[2]]}, {x, 
            p1[[1]], p2[[1]]}];

This function wraps a sampling function around output of an arbitrary binary function (for example, IntegerDigits or Gray order), which transforms decimal coordinates used in a tabular ennumeration.

Reorientation

mirror[states_] := Reverse[#] & /@ states;
reorient[{}, states_] := states;
reorient[rtflist_, states_] := 
        ReleaseHold[
          Last[ComposeList[{Hold[Reverse], Hold[Transpose], 
                    Hold[mirror]}[[Flatten[rtflist]]], dummy]] /. 
            dummy -> states];
orient[{}, states_] := states;
orient[rtflist_, states_] := 
        ReleaseHold[
          Last[ComposeList[{Hold[Transpose], Hold[Reverse], 
                    Hold[mirror]}[[Flatten[rtflist]]], dummy]] /. 
            dummy -> states];
charplan = 
        Partition[
          Join[CharacterRange["a", "e"], "•" & /@ 
              Range[20]], 5];
orang = {{}, {2}, {1, 2}, {1, 2, 3}, {2, 3}, {3}, {1, 
            3}, {1}};
ormix[n_] := 
        orang[[If[IntegerQ[n/45], 1 + Mod[n, 360]/45]]];

Square rotations are composed from the rtm compositions reversal, transposition, and a mirroring of left and right—like this, for example:

\(\(Print[
        DisplayForm[
          FrameBox[
            TableForm[
              Partition[
                Insert[\((\({""" <> ToString[#\ 45] <> "" " <> 
                            StringJoin[{"T", "R", "M"}[\([ormix[
                                    45\ #]]\)]] <> " " <> 
                            ToString[\((If[
                                  FromDigits[ormix[45\ #]] == 
                                    0, "", FromDigits[ormix[45\ #]]])\)], 
                          FrameBox[
                            GridBox[
                              orient[ormix[45\ #], charplan]]]} &\) /@ {3, 2, 
                        4, 1, 5, 8, 6, 
                        7})\), " ", {{1}, {3}, {4}, {4}, {6}, {6}, {7}, {9}}], 4]]]]];\)\)

\(\(Print[
        DisplayForm[
          RowBox[{FrameBox[
                TableForm[{StringJoin[{"T", "R", "M"}[\([{1, 2, 
                            3}]\)]], 
                    FrameBox[GridBox[orient[{1, 2, 3}, charplan]]]}]], 
              FrameBox[
                TableForm[
                  Partition[\({StringJoin[{"T", "R", "M"}[\([#]\)]], FrameBox[GridBox[orient[#, charplan]]]} &\) /@ 
                      Flatten[Transpose[Outer[List, Range[3], Range[3]]], 1], 
                    3]]]}]]];\)\)

Multiplexed superimposition

purepowerplane[powerbase_, planes_, overlays_] := 
        Fold[#1 + (powerbase^#2) planes[[1 + #2]] &, First[planes], 
          Range[overlays]];

Powered or averaging consolidation of tables into one table:

powerplane[1, 
        orang, {Partition[Random[Integer] & /@ Range[25], 5], 
          Partition[Random[Integer] & /@ Range[25], 5]}, 7] // 
      TableForm

powerplane[2, 
        orang, {Partition[Random[Integer] & /@ Range[25], 5], 
          Partition[Random[Integer] & /@ Range[25], 5]}, 7] // 
      TableForm

Color depth

rgbpartition[data_, rgbdepth_] := FromDigits[#, 2] & /@ 
        Partition[Take[data, -3 rgbdepth], rgbdepth]

This partitions a list of bits into sublists for RGBColors.

Assembling the color planes

Here is simple code to assemble tables of values into one table of meshed values, and to dissamble such a meshed table into planar tables.

plantomesh[planes_] := Transpose[planes, {3, 1, 2}];
meshtoplan[mesh_] := Transpose[mesh, {2, 3, 1}];

With[{m = Array[Random[Integer] &, {3, 5, 7}]}, 
      m == meshtoplan[plantomesh[m]]]

Utility for large images

directexport[dirname_, exportformat_, func_, 
          ranges_] := {CreateDirectory[ToString[ToString[dirname]]], 
          SetDirectory[ToString[dirname]], 
          MapIndexed[
            Export @@ Flatten[{ToString[dirname] <> "-" <> 
                      StringJoin[
                        PadLeft[Characters[ToString[#2[[1]]]], 
                          Ceiling[
                            Log[10. , Length[ranges]]], "0"]] <> "." <> 
                      ToLowerCase[ToString[exportformat]], func[##], 
                    ToUpperCase[ToString[exportformat]]}, 1] &, ranges], 
          ResetDirectory[]};

The above code creates a directory and saves slices of an image there.

Artinit 1: An initialization with art in it.

Legend

Random is a built-in function of Mathematica based on the cellular automaton with rule number 30. Random and CellularAutomaton are initialized with bits that can be ordered in what might be called an "intialization map." IntegerDigits and a Gray code function offer default choices for ordering the coordinates of such maps. These coordinate bits can be transposed. Random and CellularAutomaton are used to generate sequences of events or a column of results that can be sampled by taking every second bit or by forgetting bits. Fourier transformation helps to explore the differences between Random and cellular rule 30. The poster features a big initialization map defined by Gray ordered bit coordinates, which are transposed and flattened before obtaining the seed number from those bits. Each of the three colors multiplexes eight random bits, thus painting a pixel by one initialization for 24 calls to Random. The output looks like a 256*256 matrix of 16*16 submatrices. The overall impression is not spectacular, but the submatrices feature a universe of fascinating colorful differences.

Disclaimer

This is no attempt to cryptoanalyze Random. Similar initial conditions should produce similar results, and the actual sequences can be different even if there are local correspondences between streams of events starting at similar conditions.

SeedRandom[2 2^24];
a = Table[Random[Integer], {128}];
SeedRandom[3 2^24];
b = Table[Random[Integer], {128}];
a == b

SeedRandom[3 2^24];
a = Table[Random[Integer], {128}];
SeedRandom[4 2^24];
b = Table[Random[Integer], {128}];
a == b

Code for the SeedRandom poster

SeedRandom initialized and sampled

reseedEvents[initial_, 
          events_] := {SeedRandom[initial], 
            Table[Random[Integer], {events}]}[[2]];

This seeds the built-in Random function of Mathematica and obtains random events.

SeedRandom Map

randomplan[fun_, forgotten_, memory_, trans_, p1_, p2_] := 
      ordersample[
        rgbpartition[
            Take[reseedEvents[
                FromDigits[Flatten[Nest[Transpose, {##}, trans]], 2], 
                forgotten + 3  memory], -3 memory], memory] &, 
        fun[#, 2, 12] &, p1, p2]

The above procedure samples the built-in Random function. "Memory" defines the number of random events used for each color. "Forgotten" obtains preliminary random bits, which are discarded. "Trans" transposes the transformed coordinate bits of the enumeration to obtain a seed value. The corresponding random sequence is partitioned for a color function.

The below example shows counting order in the left column and Gray order in the right column. The bottom row presents effects of transposing these inputs before using them as values for SeedRandom.

myRasterGraphics[
        myInsertLines[
          Table[Table[
              randomplan[{IntegerDigits, gray}[[ord + 1]], 0, 8, 
                tra, {0, 0}, {63, 63}], {ord, 0, 1}], {tra, 0, 1}], 1, 
          1, {0, 0, 0}], 256, 2] // Show

The Artinit SeedRandom Poster

Slicing the poster

The below example tests  by creating a directory and exporting two slices from the top left of the poster.

Timing[
      directexport["testdirectory", "Tiff", 
        exRasterGraphics[randomplan[gray, 0, 8, 1, #[[1]], #[[2]]], 
            256, 1] &, {{0, 16  #}, {4095, 16  #  + 15}} & /@ 
          Range[0, 0]]]

The function returns to your previous directory, but you have to return manually if you abort it.

Directory[]

ResetDirectory[]

The function does not overwrite existing directories, so you have to define new names for your experiments—or delete old results manually.

Timing[
      exRasterGraphics[
          randomplan[gray, 0, 8, 1, 2^12/2 + {-128, -128}, 
            2^12/2 + {127, 127}], 256, 1] // Show]

The example shows the middle of the poster.  It will take 256 times as long to make all the slices of the poster.  It took one hour and 40 minutes on my 800 MHz Mac (1:54 to 3:36).  The slices can then be joined quickly with utility software like Graphics Converter (which took a minute here).

The code below creates a 24-bit tiff for a poster that is 4096*4096 at size scale factor 1.  Two 2^12 Gray code coordinates are transposed to get the initialization for 2^24 sequences of 24 random events.

directexport["seedmap2", "Tiff", 
      exRasterGraphics[randomplan[gray, 0, 8, 1, #[[1]], #[[2]]], 
          256, 1] &, {{0, 64  #}, {4095, 64  #  + 63}} & /@ 
        Range[0, 63]]

Artinit 2: Elementary Space Rules

Legend

Look into a corner. The two walls and the floor provide three inputs for elementary rules. 
The room is filled if the rule returns 1 for the inputs given and stays empty otherwise.

Code for elementary space rules

Level and area reached by elementary rules in spaces

cuboidlevel[g_] := 
        Table[Table[
            Table[Cuboid[{x, y - x, z - y}], {x, 0, y}], {y, 0, z}], {z, g, 
            g}];

Potentially marked cells for a first generation and a later generation are represented by cuboids.

Show[
        Graphics3D[{EdgeForm[], cuboidlevel[7], cuboidlevel[1]}, 
          ImageSize -> 256]];

Elementary space step

A triangular region of cells is shifted and added with coefficients to access bits of a rule number.

uppad[t_] := Join[t, {0 & /@ Range[Length[t] + 1]}];
leftpad[t_] := Join[{{0}}, Join[{0}, #] & /@ t];
rightpad[t_] := Join[{{0}}, Join[#, {0}] & /@ t];
tripad[t_] := 
        4 uppad[t] +  2 leftpad[t] + rightpad[t];
trimap[r_List, t_] := 
        Map[r[[8 - #]] &, tripad[t], {-1}];

Iteration and composition

Iteration transforms the initial conditions by repeated application of one rule.  Composition applies different rules.

iteratetriangle[r_, t_, g_] := 
        Nest[trimap[r, #] &, t, g];
iteratepyramid[r_, t_, g_] := 
        NestList[trimap[r, #] &, t, g];
composetriangle[r_, t_] := Fold[trimap[#2, #1] &, t, r];
composepyramid[r_, t_] := 
        FoldList[trimap[#2, #1] &, t, r];

Initialization by triangles

We may want to initialize elementary-space-rules automata with triangular patterns of cells.

emptytriangle[g_] := 
        iteratetriangle[1 & /@ Range[8], {{1}}, g + 2] - 
          rightpad[
            leftpad[uppad[
                iteratetriangle[1 & /@ Range[8], {{1}}, 
                  g - 1]]]];

initialspace = emptytriangle[4]; 
    ColumnForm[initialspace, Center]

Rectangular padding

A triangular pattern can be padded into a square. Growth of an iterated or composed pattern can be compensated by embedding into a given square.

squarepad[t_, padwith_] := 
        With[{h = 
              With[{g = Length[Last[t]]}, 
                MapIndexed[
                  Join[Table[padwith, {g - #2[[1]]}], #, 
                      Table[padwith, {g - #2[[1]]}]] &, 
                  t /. {0 -> Sequence[0, 0], 
                      1 -> Sequence[1, 1]}]]}, 
          Flatten[Transpose[{h, h}, {2, 1, 3}], 1]];
reembed[t_, metasize_, corepadwith_:  0, 
          padwith_:  
            0] := With[{w = Length[#]}, 
              Transpose[
                Join[Table[padwith, {(metasize - w)/2}, {metasize}], 
                  Transpose[
                    Join[Table[padwith, {(metasize - w)/2}, {w}], #, 
                      Table[padwith, {(metasize - w)/2}, {w}]]], 
                  Table[padwith, {(metasize - w)/
                        2}, {metasize}]]]] & /@ (squarepad[#, 
                  corepadwith] & /@ t);

Cuboid representation

cuboidtriangle[data_, 
          observed_] := Flatten[
              With[{g = Length[#]}, 
                Table[Table[
                    If[#[[y + 1, x + 1]] == 1, 
                      Cuboid[{x, y - x, g - y - 1}], {}], {x, 0, y}], {y, 0, 
                    g - 1}]]] & /@ Take[data, observed];
cuboidtriangle[data_] := 
        cuboidtriangle[data, {1, Length[data]}];

In order to speed up rendering, a cuboid representation can select stages of evolution to observe.

Show[
      Graphics3D[{EdgeForm[], 
          cuboidtriangle[
            composepyramid[Array[Random[Integer] &, {2, 8}], initialspace]]}, 
        ViewPoint -> -{1, 1, 1}, ImageSize -> 512]]

Poster for elementary space rules

Without color

Show[
      myRasterGraphics[
        myInsertLines[
          Table[myInsertLines[{{squarepad[
                    iteratetriangle[IntegerDigits[x + 16  y, 2, 8], {{1}}, 
                      8], 0]}}, 1, 1, 0], {y, 0, 15}, {x, 0, 15}], 1, 1, 1], 
        2, 2]]

The final states for 256 rules are illustrated above. The following examples try to capture all stages of evolution.

space256by18 = 
        Table[reembed[
            iteratepyramid[IntegerDigits[x + 16  y, 2, 8], {{1}}, 7], 
            18], {y, 0, 15}, {x, 0, 15}];

Show[
      myRasterGraphics[
        myInsertLines[Map[purepowerplane[1, #, 7] &, space256by18, {2}], 1, 
          1, 7], 8, 2]]

Show[
      myRasterGraphics[
        myInsertLines[Map[purepowerplane[2, #, 7] &, space256by18, {2}], 1, 
          1, 255], 256, 2]]

space256by24 = 
        Table[reembed[
            iteratepyramid[IntegerDigits[x + 16  y, 2, 8], {{1}}, 23], 
            50], {y, 0, 15}, {x, 0, 15}];

Show[
      myRasterGraphics[
        myInsertLines[Map[purepowerplane[1, #, 23] &, space256by24, {2}], 1, 
          1, 23], 24, 1]]

Table of elementary space rules in color

Show[
      myRasterGraphics[
        myInsertLines[{{255 - 
                plantomesh[{
myInsertLines[
                      Map[purepowerplane[2, #, 7] &, 
                        space256by24[[All, All, Range[1, 8]]], {2}], 1, 
                      1, 255], 
myInsertLines[
                      Map[purepowerplane[2, #, 7] &, 
                        space256by24[[All, All, Range[9, 16]]], {2}], 1, 
                      1, 255], 
myInsertLines[
                      Map[purepowerplane[2, #, 7] &, 
                        space256by24[[All, All, Range[17, 24]]], {2}], 1, 
                      1, 255]
}]}}, 1, 1, {0, 0, 0}], 256, 
        1]]

Here are multiplexed states for 256 rules inverted and non-inverted, which might be more intuitive.

Show[
      myRasterGraphics[
        myInsertLines[{{plantomesh[{
myInsertLines[
                    Map[purepowerplane[2, #, 7] &, 
                      space256by24[[All, All, Range[1, 8]]], {2}], 1, 1, 
                    255], 
myInsertLines[
                    Map[purepowerplane[2, #, 7] &, 
                      space256by24[[All, All, Range[9, 16]]], {2}], 1, 1, 
                    255], 
myInsertLines[
                    Map[purepowerplane[2, #, 7] &, 
                      space256by24[[All, All, Range[17, 24]]], {2}], 1, 
                    1, 255]
}]}}, 1, 1, {0, 0, 0}], 256, 
        1]]

Elementary rules for cuboids

Show[
      Graphics3D[{EdgeForm[], 
          cuboidtriangle[
            iteratepyramid[IntegerDigits[57, 2, 8], {{1}}, 23]]}, 
        ViewPoint -> {1, 1,  .5}]]

The example above iterates one rule. The example below composes random rules.

SeedRandom[0];

Show[
      Graphics3D[{EdgeForm[], 
          cuboidtriangle[
            composepyramid[Array[Random[Integer] &, {24, 8}], {{1}}]]}, 
        ViewPoint -> {1, 1,  .5}, ImageSize -> 512]]

3D Array

This produces tabulated cuboid representations for all elementary space rules from front and back.

Show[
      GraphicsArray[
        Table[Table[
            GraphicsArray[{{Graphics3D[{EdgeForm[], 
                      cuboidtriangle[
                        iteratepyramid[IntegerDigits[x + 16 y, 2, 8], {{1}}, 
                          4]]}, Boxed -> False, 
                    ViewPoint -> {1, 1, 1}]}, {Graphics3D[{EdgeForm[], 
                      cuboidtriangle[
                        iteratepyramid[IntegerDigits[x + 16 y, 2, 8], {{1}}, 
                          4]]}, Boxed -> False, 
                    ViewPoint -> -{1, 1, 1}]}}, 
              GraphicsSpacing -> 0], {x, 0, 15}], {y, 0, 15}], 
        GraphicsSpacing ->  .1], GraphicsSpacing -> {1,  .25}, 
      TextStyle -> {FontFamily -> "Times", FontSize -> 36}, 
      Frame -> True, 
      FrameStyle -> {{RGBColor[0, 0, 0]}, {RGBColor[1, 1, 1]}, {RGBColor[
              0, 0, 0]}, {RGBColor[1, 1, 1]}}, 
      FrameLabel -> {"Schreiber.at NKS 2004", "", "Elementary \
Space Rules", ""}, ImageSize -> 500]

Further elementary space rules poster

Special examples

Table[
      Show[myRasterGraphics[
          squarepad[
            iteratetriangle[
              IntegerDigits[{25, 57, 103, 121, 135, 137}[[j]], 2, 
                8], {{1}}, 192]], 2, 1], 
        PlotLabel -> {25, 57, 103, 121, 135, 137}[[j]]], {j, 1, 
        6}]

This provides more detail for representatives of elementary rules that do not look trivial. Below are examples for compositions.

SeedRandom[0];

Show[
      Graphics3D[{EdgeForm[], 
          cuboidtriangle[
            composepyramid[Array[Random[Integer] &, {2, 8}], initialspace]]}, 
        ViewPoint -> -{1, 1, 1}, ImageSize -> 512]]

SeedRandom[0];

myRasterGraphics[
        squarepad[
          composetriangle[Flatten[{1, #, 0}] & /@ 
              Array[Random[Integer] &, {24, 6}], initialspace],  .5], 2, 1] // 
      Show

Animation

Finally, here are eight stages of iteration animated for all elementary rules.

Table[
      Show[myRasterGraphics[
          myInsertLines[{{myInsertLines[space256by18[[All, All, k]], 1, 
                  1, 1]}}, 1, 1, 0], 2, 2]], {k, 1, 8}]

Artinit 3: Composed oracles

Legend

We use the built-in Random function to generate candidate sequences of CA rules for our composition. We customize the mix of rules by excluding those that permit three equal inputs to create an output of the different color. This means that we have to exclude all rules with a leftmost or  rightmost zero. The prototype of such acceptable rule numbers is 1******0 if the star * indicates a wildcard placeholder for a choice between 1 and 0.

Or, in terms of an old oracle from China: 
Three 1s return 1. 
Three 0s return 0. 
Between one and nothing six Yi Jing choices between Yin and Yang.

Long DeBruijn sequences are needed to cover all initial conditions for a composition of a small number of rules.

Disclaimer

Chinese oracles are not introduced to change your style of making a rational or unpredictable decision.  They are simply used as an example for didactic interfaces that might help to popularize NKS outside of the USA and Europe.

Code for a Composition poster

Initialization of SeedRandom by four Yi states

yiSeedRandom[yinit_] := 
        SeedRandom[
          Total[yinit {64^3, 64^2, 64, 1}]];
yiBits[n_Integer] := Table[Random[Integer], {n}];

Random Yi events are sampled as lists of six random bits (random integers between 0 and 63 would give different results).

yiSeedRandom[{0, 0, 0, 0}]; 
    With[{y = yiBits[24]}, {FromDigits[Reverse[#], 2] & /@ 
          Partition[y, 6], FromDigits[#, 2] & /@ 
          Partition[y, 6]}]

yiSeedRandom[{0, 0, 0, 0}]; 
    Table[Random[Integer, {0, 63}], {4}]

Wrapping the CA prototype around Yi states

deciproto[randomsource_, bitprototype_] := 
        bitproto[
          IntegerDigits[randomsource, 2, Length[bitprototype[[1]]]], 
          bitprototype];
bitproto[randombitsource_, bitprototype_] := 
        Insert[Insert[randombitsource[[bitprototype[[1]]]], 0, 
            bitprototype[[2]]], 1, bitprototype[[3]]];
oracle = {Range[6], -1, 1};

The function above illustrates an interpretation that wraps the 1******0 prototype CA rule around the 64 possibilities defining a state and thus one half of a change in the book of changes aka Yi Jing (I Ching).

{bitproto[0 & /@ Range[6], oracle], 
      deciproto[63, oracle]}

Composing prototyped oracle states as cellular automaton rules

yiyicomposition[in_, com_, sampin_, sampcomp_, function_, prototype_] := 
      Flatten[FoldList[
          CellularAutomaton[
              FromDigits[function[#2, prototype], 2], #1[[1]], 
              1, {-1, All}] &, {Take[
              in, {sampin[[1]], sampin[[2]]}]}, 
          Take[com, {sampcomp[[1]], sampcomp[[2]] - 1}]], 
        1]

Artinit Yi

Uncolored

yiSeedRandom[{1, 1, 1, 1}];

With[{wide = 256, events = 194}, 
        With[{yievents = yiBits[6] & /@ Range[events]}, 
          myRasterGraphics[
            Plus @@ Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                  yiyicomposition[db12, 
                    yievents, {1 + k wide, wide + k wide}, {1, events}, 
                    bitproto, oracle], {k, 0, 15}], 16, 2]]] // 
      Show

Colored

yiSeedRandom[{0, 0, 0, 0}];

yibank[0] := yiBits[6] & /@ Range[4096];

yiSeedRandom[{1, 1, 1, 1}];

yibank[1] := yiBits[6] & /@ Range[4096];

yiSeedRandom[{2, 2, 2, 2}];

yibank[2] := yiBits[6] & /@ Range[4096];

With[{wide = 512, events = 512}, 
        myRasterGraphics[
          plantomesh[{Plus @@ 
                Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                    yiyicomposition[db12, 
                      yibank[0], {1 + k wide, wide + k wide}, {1, events}, 
                      bitproto, oracle], {k, 0, 7}], 
Plus @@ 
                Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                    yiyicomposition[db12, 
                      yibank[1], {1 + k wide, wide + k wide}, {1, events}, 
                      bitproto, oracle], {k, 0, 7}], 
Plus @@ 
                Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                    yiyicomposition[db12, 
                      yibank[2], {1 + k wide, wide + k wide}, {1, events}, 
                      bitproto, oracle], {k, 0, 7}]
}], 8, 
          1]] // Show

The above version observes only one eighth of the composition, and folds the DeBruijn initialization by averaging over results in mirrored intervals. The exported version unfolds the layered planes and uses different colors for the three seeds.

Export["yi12i111.tiff", 
      With[{wide = 4096, events = 4096}, 
        exRasterGraphics[
          plantomesh[{Plus @@ 
                Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                    yiyicomposition[db12, 
                      yibank[0], {1 + k wide, wide + k wide}, {1, events}, 
                      bitproto, oracle], {k, 0, 0}], 
Plus @@ 
                Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                    yiyicomposition[db12, 
                      yibank[1], {1 + k wide, wide + k wide}, {1, events}, 
                      bitproto, oracle], {k, 0, 0}], 
Plus @@ 
                Table[Nest[Reverse[#] &, #, Mod[k, 2]] & /@ 
                    yiyicomposition[db12, 
                      yibank[2], {1 + k wide, wide + k wide}, {1, events}, 
                      bitproto, oracle], {k, 0, 0}]
}], 2, 
          1]], "TIFF", ImageSize -> 4096]

Notes

Reverse view of SeedRandom Map

randomplanrev[fun_, events_, memory_, trans_, rev_, p1_, p2_] := 
      ordersample[
        rgbpartition[
            Nest[Reverse, 
              Take[reseedEvents[
                  FromDigits[Flatten[Nest[Transpose, {##}, trans]], 2], 
                  events + 3  memory], -3 memory], rev], memory] &, 
        fun[#, 2, 12] &, p1, p2]

Reversal of random events obtained from one seed create local mutations of the pattern.

Table[
      Show[myRasterGraphics[
          myInsertLines[
            Table[Table[
                randomplanrev[{IntegerDigits, gray}[[ord + 1]], 0, 8, 
                  tra, j, {0, 0}, {63, 63}], {ord, 0, 1}], {tra, 0, 1}], 1, 
            1, {0, 0, 0}], 256, 2]], {j, 0, 1}]

The images in the following table shift the map by sampling additional events for every seed and forgetting the first samples. The two versions given compare two versions of RasterGraphics used in this notebook.

Table[
      Show[({myRasterGraphics, exRasterGraphics}[[v + 1]])[
          myInsertLines[
            Partition[
              Table[myInsertLines[
                  Table[Table[
                      randomplanrev[{IntegerDigits, gray}[[ord + 1]], j, 
                        8, tra, 0, {0, 0}, {31, 31}], {ord, 0, 1}], {tra, 0, 
                      1}], 1, 1, {255, 255, 255}], {j, 0, 15}], 4], 1, 
            1, {0, 0, 0}], 256, 2]], {v, 0, 1}]

CA rules initialized and sampled

The following function samples a column from the evolution of elementary cellular automata initialized like SeedRandom.

partofCA[rule_, initial_, steps_, columnshift_:  Automatic] := 
      Flatten[CellularAutomaton[rule, initial, 
          steps, {All, {If[columnshift === Automatic, 
                Floor[Length[initial]/2], columnshift]}}]]

Panorama CA

CAplan[rule_, fun_, events_, memory_, trans_, p1_, p2_] := 
      ordersample[
        rgbpartition[
            Take[partofCA[rule, Flatten[Nest[Transpose, {##}, trans]], 
                events + 3  memory - 1], -3 memory], memory] &, 
        fun[#, 2, 12] &, p1, p2]

Rule 30 is the rule behind the built-in Random function. The local portfolios show counting order to the left and Gray code order to the right. The bottom rows initialize by flattening the transpose of the coordinate order bits. The tabulation shifts the map into the future, forgetting maps from the past.

myRasterGraphics[
        myInsertLines[
          Partition[
            Table[myInsertLines[
                Table[Table[
                    CAplan[30, {IntegerDigits, gray}[[ord + 1]], 
                      timeshift, 8, tra, {0, 0}, {31, 31}], {ord, 0, 
                      1}], {tra, 0, 1}], 1, 1, 255 {1, 1, 1}], {timeshift, 0, 
                15, 3}], 3], 1, 1, {0, 0, 0}], 256, 3] // Show

Here is a large area with bigger pixels, showing initialization effects of transposing coordinate bits in Gray order.

myRasterGraphics[
        myInsertLines[
          Table[Table[
              CAplan[30, {IntegerDigits, gray}[[ord + 1]], 0, 8, 
                tra, {0, 0}, {127, 127}], {ord, 1, 1}], {tra, 1, 1}], 1, 
          1, {0, 0, 0}], 256, 3] // Show

Fouriered results

ria[data_] := {Re[data], Im[data], Abs[data]};

The above function obtains real, imaginary, and absulte dimensions from complex input for color illustrations. The below code uses this function to prepare planar output of Fourier transforms for Random samples seeded by a composing a function to enumerate coordinates and a function to sample random events.

riaFourier[samplingfunction_, enumerationfunction_, p1_, p2_] := 
      ria[Fourier[
ordersample[samplingfunction[##] &, 
            enumerationfunction[#] &, p1, p2]]]

Fourier SeedRandom

checkrandom[fun_, events_, memory_, trans_, p1_, p2_] := 
      Transpose[
        riaFourier[
          FromDigits[
              Take[reseedEvents[
                  FromDigits[Flatten[Nest[Transpose, {##}, trans]], 2], 
                  events], -memory], 2] &, fun[#, 2, 12] &, p1, p2], {3, 
          1, 2}]

The above function generates a meshed representation of real, imaginary, and absolute Fourier output from seed coordinates. Again, counting order coordinates are left and Gray code coordinates are right. The bottom row seeds with transposed coordinate bits. The nested patterns are not visible for Fouriers of small seed ranges.

myRasterGraphics[
        myInsertLines[{{myInsertLines[
                With[{m = 63, a = 1}, 
                  Table[{
checkrandom[IntegerDigits, a, a, 
                        t, {0, 0}, {m, m}], 
                      checkrandom[gray, a, a, t, {0, 0}, {m, m}]}, {t, 0, 
                      1}]], 1, 1, {1, 1, 1}]}}, 1, 1, {0, 0, 0}], 2, 2] // 
      Show

Fourier CA

checkCA[rule_, fun_, mid_, events_, memory_, part_, p1_, p2_] := 
      Transpose[
        riaFourier[
          FromDigits[Transpose[
                  Partition[
                    Take[partofCA[rule, Flatten[{#1, mid, #2}], 
                        events], -memory], part]][[1]], 2] &, 
          fun[#, 2, 12] &, p1, p2], {3, 1, 2}]

The function checks initialization maps of arbitrary rules. It does not feature transposition of initial coordinates but supports experiments with fixing a cell in the middle of initialization conditions. The values from the output column can be partitioned to drop all but every (k^th) result. The 24 portfolios count on the left side and Gray on the right. The bottom rows select every second result from the middle column. The portfolios in the below example move into the future of the CA evolution but Fourier only the present and the last moment. Note the particular patters around steps 13-14.

myRasterGraphics[
        myInsertLines[
          Partition[
            Table[myInsertLines[
                With[{m = 15}, 
                  Table[{
checkCA[30, IntegerDigits, {}, a, 
                        2, k, {0, 0}, {m, m}], 
checkCA[30, 
                        gray, {}, a, 2, 
                        k, {0, 0}, {m, m}]}, 
{k, 1, 2}]], 
                1, 1, If[13 < a < 16, {1, 0, 0}, {1, 1, 1}]], {a, 1, 24}], 
            6], 1, 1, {0, 0, 0}], 2, 2] // Show

Rest

Free memory

List values to be cleared:

gray12 =.

initialspace =.

space256by18 =. 
space256by24 =.

db12 =.

yibank[0] =. 
yibank[1] =. 
yibank[2] =.

End of context

Ending the Artinit context:

End[]; {$Context, $ContextPath}

Bugreport

The functions are rather powerful, but some parameters have to match or errors occur. 
What did you do?  What did you expect?  What happened?

Michael@Schreiber.at