Flatten[MapIndexed[ c[dlist, Reverse[#2]]  #1 &, Reverse[data], {2}], 1]

One can count the number of occurrences of each of the k b possible blocks of length b in a given state using BC[list_] := With[{z = Map[FromDigits[#, k] &, Partition[list, b, 1, 1]]}, Map[Count[z, #] &, Range[0, k b - 1]]] Conserved quantities of the kind discussed here are then of the form q .

Corresponding to the result on page 870 for rule 90, the number of black cells at row t in the pattern from rule 150 is given by Apply[Times, Map[(2 # + 2 - (-1) # + 2 )/3 &, Cases[Split[IntegerDigits[t, 2]], k:{1 ..}  Length[k]]]] There are a total of 2 m Fibonacci[m+2] black cells in the pattern obtained up to step 2 m , implying fractal dimension Log[2, 1 + Sqrt[5]] .

Given a sequence of length n , an approximation to h can be reconstructed using Max[MapIndexed[#1/First[#2] &, FoldList[Plus, First[list], Rest[list]]]] The fractional part of the result obtained is always an element of the Farey sequence Union[Flatten[Table[a/b, {b, n}, {a, 0, b}]]] (See also pages 892 , 932 and 1084 .)

Successive steps in the iterative procedure used on this page are given by Move[list_] := (If[Cost[#] < Cost[list], #, list] &)[ MapAt[1 - # &, list, Random[Integer, {1, Length[list]}]]] while those in the procedure on page 347 have ≤ in place of < .

The iterated map x  4x (1 - x) was also known to have a similar property (see page 918 ). … In 1962, however, Edward Lorenz did a computer simulation of a set of simplified differential equations for fluid convection (see page 998 ) in which he saw complicated behavior that seemed to depend sensitively on initial conditions—in a way that he suggested was like the map x  FractionalPart[2x] . … Then in the mid-1970s, particularly following discussion by Robert May , studies of iterated maps with sensitive dependence on initial conditions became common.

The number of sequences s n of length n that can actually occur is given by Apply[Plus, Flatten[MatrixPower[m, n]]] where the adjacency matrix m is given by MapAt[(1 + #) &, Table[0, {Length[net]}, {Length[net]}], Flatten[MapIndexed[{First[#2], Last[#1]} &, net, {2}], 1]] For rule 32, for example, s n turns out to be Fibonacci[n + 3] , so that for large n it is approximately GoldenRatio n .

One can update the gray level of each cell by using rules that are in a sense a cross between the totalistic cellular automaton rules that we discussed at the beginning of the last chapter and the iterated maps that we just discussed in the previous section .

Logic circuits [from cellular automata] The rules for the cellular automaton shown here are {{0, 1, 1 | 3}  1, {0, 3, 3}  3, {1, 0, 0 | 1 | 3}  1, {1, 1, 3}  4, {1, 3, 0}  3, {1, 3, 3}  2, {2, 1, 3}  3, {2, 3, 0}  2, {2, 0, _}  4, {3, 3, 0}  3, {4, 0, 0 | 1 | 2 | 4}  2, {4, 3, 3}  3, {4, 1, 3}  1, {4, 3, 0}  4, {_, _, _}  0} The initial conditions are given by Flatten[Block[{And, Or}, Map[{0, 2 (# + 1)} &, expr, {-1}] //. {!

3D network The 3D network (c) can be laid out in space using Array[x[8 {##}] &, {n, n, n}] where x[m:{_, _, _}] := {x 1 [m], x 1 [m + 4], x 2 [m + {4, 2, 0}], x 2 [m + {0, 6, 4}]} x 1 [m:{_, _, _}] := Line[Map[# + m &, {{1, 0, 0}, {1, 1, 1}, {0, 2, 1}, {1, 1, 1}, {3, 1, 3}, {3, 0, 4}, {3, 1, 3}, {4, 2, 3}}]] x 2 [{i_, j_, k_}] := x 1 [{-i - 4, -j - 2, k}] /.