Huffman coding From a list p of probabilities for blocks, the list of codewords can be generated using Map[Drop[Last[#], -1] &, Sort[ Flatten[MapIndexed[Rule, FixedPoint[Replace[Sort[#], {{p0_, i0_}, {p1_, i1_}, pi___}  {{p0 + p1, {i0, i1}}, pi}] & , MapIndexed[List, p]] 〚 1, 2 〛 , {-1}]]]] -1 Given the list of codewords c , the sequence of blocks that occur in encoded data d can be uniquely reconstructed using First[{{}, d} //. MapIndexed[ {{r___}, Flatten[{#1, s___}]}  {{r,#2 〚 1 〛 },{s}} &, c]] Note that the encoded data can consist of any sequence of 0's and 1's.

Generating causal networks If every element generated in the evolution of a generalized substitution system is assigned a unique number, then events can be represented for example by {4, 5}  {11, 12, 13} —and from a list of such events a causal network can be built up using With[{u = Map[First, list]}, MapIndexed[Function[ {e, i}, First[i]  Map[(If[# === {}, ∞ , # 〚 1, 1 〛 ] &)[ Position[u, #]]) &, Last[e]]], list]]

Implementation [of finite automata for nested patterns] Given the rules for a substitution system in the form used on page 931 a finite automaton (as on page 957 ) which yields the color of each cell from the digit sequences of its position is Map[Flatten[MapIndexed[#2 - 1  Position[rules, #1  _] 〚 1, 1 〛 &, Last[#], {-1}]] &, rules] This works in any number of dimensions so long as each replacement yields a block of the same cuboidal form.

Numbering scheme [for Turing machines] One can number Turing machines and get their rules using Flatten[MapIndexed[{1, -1} #2 + {0, k}  {1, 1, 2} Mod[Quotient[#1, {2k, 2, 1}], {s, k, 2}] + {1, 0, -1} &, Partition[IntegerDigits[n, 2 s k, s k], k], {2}]] The examples on page 79 have numbers 3024, 982, 925, 1971, 2506 and 1953.

The program in the multiregister machine can be converted to a program for the 2-register machine according to RMToRM2[prog_] := Module[{segs, adrs}, segs = MapIndexed[seg, prog]; adrs = FoldList[Plus, 1, Map[Length, segs]]; MapIndexed[#1 /.

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

Given p = Array[Prime, Length[list], PrimePi[Max[list]] + 1] or any list of integers that are all relatively prime and above Max[list] (the integers in list are assumed positive) CRT[list_, p_] := With[{m = Apply[Times, p]}, Mod[Apply[Plus, MapThread[#1 (m/#2)^EulerPhi[#2] &, {list, p}]], m]] yields a number x such that Mod[x, p]  list . Based on this LE[list_] := Module[{n = Length[list], i = Max[MapIndexed[ #1 - #2 &, PrimePi[list]]] + 1}, CRT[PadRight[ list, n + i], Join[Array[Prime[i + #] &, n], Array[Prime, i]]]] will yield a number x that can be decoded into a list of length n using essentially the so-called Gödel β function Mod[x, Prime[Rest[NestList[NestWhile[# + 1 &, # + 1, Mod[x, Prime[#]]  0 &] &, 0, n]]]]

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 .)

A single step in evolution of a general cellular automaton with state a and rule number num is then given by Map[IntegerDigits[num, k, k^Length[os]] 〚 -1 - # 〛 &, Apply[Plus, MapIndexed[k^(Length[os] - First[#2]) RotateLeft[a, #1] &, os]], {-1}] or equivalently by Map[IntegerDigits[num, k, k^Length[os]] 〚 -# - 1 〛 &, ListCorrelate[Fold[ReplacePart[k #1, 1, #2 + r + 1] &, Array[0 &, Table[2r + 1, {d}]], os], a, r + 1], {d}]

Applying BitReverseOrder to this matrix yields a matrix which has an essentially nested form, and for size n = 2 s can be obtained from Nest[With[{c = BitReverseOrder[Range[0, Length[#] - 1]/ Length[#]]}, Flatten2D[MapIndexed[#1 {{1, 1}, {1, -1} (-1)^c 〚 Last[#2] 〛 } &, #, {2}]]] &, {{1}}, s] Using this structure, one obtains the so-called fast Fourier transform which operates in n Log[n] steps and is given by With[{n = Length[data]}, Fold[Flatten[Map[With[ {k = Length[#]/2}, {{1, 1}, {1, -1}} .