Rewriting Systems

Jaime Rangel-Mondragón

About the Author

Jaime Rangel-Mondragon earned M. Sc. and Ph. D. degrees in Applied Mathematics and Computation from the University College of North Wales in Bangor, Great Britain. He has held research positions in the School of Informatics at UCNW Bangor, U.K., the College of Mexico, the Center of Research and Advanced Studies, the Monterrey Institute of Technology and the University of Queretaro in Mexico, where he currently works at the Faculty of Informatics. Prolific contributor to MathSource, his current research include Combinatorics, Theory of Computing, Functional Languages, Computational Geometry and Recreational Mathematics.

Acknowledgements

This work was finished at Wolfram Research Inc., in Champaign IL, USA, while the author was spending two months as a Visiting Scholar. Their assistance and enthusiastic support is gratefully acknowledged. My thanks are also given for the continuous support received from the University of Queretaro in Mexico.

References

Cellular Automata and Complexity 
S. Wolfram
Perseus, 1994

The Algorithmic Beauty of Plants
A. Lindenmeyer	 
Springer-Verlag, NY, 1990

Power Programming with Mathematica. The Kernel
D. B. Wagner
McGraw-Hill, 1996

Term rewriting and Programming Paradigms
R. E. Maeder
in Mathematics with Vision
Proceedings of the First International Mathematica Symposium
Computational Mechanics Publications 1995, pp. 7-19

Programming in Mathematica
R. E. Maeder
Addison-Wesley, second edition, 1991

Self-similar Mosaics
N. Dolbilin
Quantum, July/August 2000, pp.4-9

Rewriting systems (RS), also called Reduction Systems, String Rewriting Systems or Term Rewriting Systems, have been widely used in contexts in which formulae manipulation plays a prominent role, such as symbolic and functional programming, formal grammars (useful in the design of compilers and interpreters), computer graphics, simulation, etc. This is due to their intrinsic ability to specify, through employing a set of directed transformational equations, the basic mechanism of subterm substitution. Repeated applications of this mechanism on a given term are considered as leading to a “simpler form” of this term. However, it is possible that we might never arrive at this simple form - called normal form, due to either divergence or cycling of the terms generated.

RS are determined by a series of productions meant to be applied to specific objects. This application consists in the substitution of a pattern occurring on the object also appearing on the left side of a production, by the corresponding pattern on the right side of this production. Consider, for example the following simple RS:

		21 -> 12
		31 -> 13
		32 -> 23

Throughout its repeated application on a given word w ∈ {1, 2, 3}* (that is, the objects we are considering consist on all strings of symbols taken from the alphabet {1, 2, 3}), we obtain a sorted anagram of w. It does not matter in which order we apply the rules, the convergence to the normal form is inevitable and it leads to a word of the form 1*2*3*. Such systems are called confluent or Church-Rosser. This paradigm is also present in the study of cellular automata, wherein the notion of transitions over discrete state spaces is characterized by this approach.

The aim of this work is to illustrate the application of RS on a variety of important settings throughout the following sections: One-dimensional Checkers,  Group Theory,  Equivalence Relations, Systems of  Numeric Productions, Recursive Productions, L systems,  From Binary Numbers to Compositions and Huffman Coding, providing a smorgasbord of ideas on this fascinating topic. A series of animations supplementing several parts of  the text is also provided. We are using Mathematica version 5

1.- One-dimensional Checkers

Not all RS are confluent. Consider, for example, the following:

110 -> 001
011 -> 100

which corresponds to the jumps made in the one-dimensional version of the game of checkers. If we consider as the normal form of a word that one containing only one occurrence of the symbol 1, disregarding the number of symbols 0 it contains, then not all words lead to normal forms, and even those that do might not reach it due to the non-deterministic character of the rewriting rules. Termination is, in general an undecidable property of RS. For example, the word 0110011110 possess a normal form but applying the first of the above rules to obtain 0110011001 leads it away from reaching it. 

Let us obtain all "valid" words, that is, those words of a given size n having normal form and hence leading to a successful solitaire game of one-dimensional checkers. Valid words are of the form 1x1 where x ∈ {0, 1}* is a word of length n-2. We can readily obtain the set of all valid words from an initial list of candidates.

candidates[n_] := 
      Map[Join[{1}, IntegerDigits[#, 2, n - 2], {1}] &, 
        Range[0, (2^(n - 2)) - 1]]

candidates[5]

And the rules can be coded as:

jump := {{X___, 1, 1, 0, Y__} -> {X, 0, 0, 1, Y}, {X__, 0, 1, 1, 
            Y___} -> {X, 1, 0, 0, Y}}

The non-determinism in applying this rule is captured by Mathematica's function ReplaceList.

ReplaceList[{1, 1, 1, 0, 1, 1, 1, 1}, jump]

In jumping at the end positions, we have to eliminate any leading and trailing zeroes that might appear. We accomplish this by making use of function compress and changing the jumping transformations accordingly.

compress[{0, x__}] := compress[{x}]
compress[{x__, 0}] := compress[{x}]
compress[x_] := x

    
jump := {{X___, 1, 1, 0, Y__} :> 
          compress[{X, 0, 0, 1, Y}], {X__, 0, 1, 1, Y___} :> 
          compress[{X, 1, 0, 0, Y}], 
{1, 
            1} :>  {1, 1} }

We are  interested in succesively applying junp to get to {1, 1} (or equivalently to 1; we choose this criteria so that we always have an ending pair of 1's). By using FixedPointList we obtain all successive positions from a given starting one.

FixedPointList[
      Flatten[ReplaceList[#, jump] &  /@  #, 1] &, {{1, 1, 1, 0, 1, 1, 
          1, 1}}]

This means that there are five ways to succeed, and correspond to the building of the game tree

Let us encapsulate all the above in predicate validQ which decides whether a given word leads to a winning game.

validQ[
        word_List] := (FixedPoint[
            Union[Flatten[ReplaceList[#, jump] &  /@  #, 
                  1]] &, {word}] == {{1, 1}})

Note we take the union to expedite the decision, and in doing so we graft several branches of the game tree. So, for instance, the valid words of size 8 are obtained as:

FromDigits  /@  Select[candidates[8], validQ]

The sequence of valid words begins as:

Sort[
      Flatten[Table[
          FromDigits  /@  Select[candidates[n], validQ], {n, 
            10}]]]

(to which we have to include 1 of course)

Note that there cannot be three consecutive 0's in any of the above words. Similarly, a valid word has to have even length. The reason for this is the following. By looking at the reverse process whereby we start at 11 and finish at a valid word we observe two kind of moves. Those that extend the word sideways - increasing its length by 2 adding a 0 and a 1, and those that only rearrange the internal configuration by eliminating a 0 and adding a 1 without changing the length of the word. Hence any valid word must have even length.
Note also that, if 1X1 is a valid word, then words 110X1 and 1X011 are also valid, for any word X (valid or not). Apparently, this could be used to generate all valid words by the number of steps they require to reach word 11.

steps[1] := {{1, 1}}
steps[n_] := 
      Flatten[Map[{Join[{1, 1, 0}, Rest[#]], 
              Join[Delete[#, -1], {0, 1, 1}]} &, steps[n - 1]], 
        1]

Table[
        FromDigits  /@  steps[n], {n, 5}] ;
Sort[Flatten[%]]

However, this approach is flawed (can you see why? hint: how many steps needs the word 101111 to reach 1?). An interesting problem is: for what numbers n, m such that 0 < n ≤ m, the word (1^n)0(1^m) is a valid one?

2.- Group Theory

Roughly speaking, a RS is a non-deterministic, pattern-oriented program transforming terms into terms. As an example, let us consider the algebraic structure group, by which a set S is classified in accordance to compliance to the following axioms (explicit bi-directional commutativity with the identity element and inverses is commonly assumed in general but it is not necessary, as we aim to show.)

wherein f: S × S -> S is a closed binary operation (not necessarily commutative) on S, e is a special element of S and a, b and c are arbitrary elements of  S. The first axiom asserts the existence of a left identity, the second of a left inverse and the third the fact that f is associative. 

These axioms enjoy a dual character in their interpretation; the first axiom establishes the way the left identity acts on any element of S and can be interpreted as that, wherever an f[e, a] appears it can be simplified to a. On the other hand, it also can be interpreted as that, wherever an element a appears, it can be expanded by f[e, a]. It is possible to derive valid general structural equations on S by regarding these axioms as rewriting rules. Let us illustrate this by solving the problem of deducing the existence of right identity and right inverses, being equal to their left counterparts.

The bi-directional character of the axioms above gives rise to the following six productions, wherein for the sake of clarity we have adopted the infix notation x • y to stand for f(x, y):

e • a -> a

a ->  e • a

(a^(-1)) • a -> e

e ->  (a^(-1)) • a

(a • b) • c -> a • (b • c)

a • (b • c) -> (a • b) • c

We now proceed to show that a • e -> a through the following sequence of applications in which we indicate above the arrow which of the former six productions is being used at each step.

a • e 	 (Overscript[-> , 2])  (e • a) • e 
					 (Overscript[-> , 4]) ((((((a^(-1))))^(-1)) • (a^(-1))) • a ) • e 	
					 (Overscript[-> , 5]) (((((a^(-1))))^(-1)) • ((a^(-1)) • a )) • e
					 (Overscript[-> , 3])  (((((a^(-1))))^(-1)) • e ) • e
					 (Overscript[-> , 5])  ((((a^(-1))))^(-1)) • ( e • e )
					 (Overscript[-> , 1])  ((((a^(-1))))^(-1)) • e
					 (Overscript[-> , 4])  ((((a^(-1))))^(-1)) • ((a^(-1)) • a )
					 (Overscript[-> , 6])  (((((a^(-1))))^(-1)) • (a^(-1))) • a
					 (Overscript[-> , 3])  e • a
					 (Overscript[-> , 1])  a

Hence f(a, e) = a. Similarly:

a • (a^(-1))  (Overscript[-> , 2]) e • ( a • (a^(-1)))  (Overscript[-> , 4]) (((((a^(-1))))^(-1)) • (a^(-1)) ) • ( a • (a^(-1))) 
			 (Overscript[-> , 5]) ((((a^(-1))))^(-1)) • ( (a^(-1)) • ( a • (a^(-1))))  (Overscript[-> , 6]) ((((a^(-1))))^(-1)) • (( (a^(-1)) • a ) • (a^(-1))) 
			 (Overscript[-> , 3]) ((((a^(-1))))^(-1)) • ( e • (a^(-1)))  (Overscript[-> , 1]) ((((a^(-1))))^(-1)) • (a^(-1))  (Overscript[-> , 3]) e

Hence f(a, (a^(-1))) = e.

Another interesting example is the following proof that \(TraditionalForm\`\(\(f\^-\)\^1\)(a, 
          b) = \(\(f(b\^\(-1\), a\^\(-1\))\)\(:\)\)\)

(((a • b))^(-1))    (Overscript[-> , 6]) e • (((a • b))^(-1))  (Overscript[-> , 4]) ((b^(-1)) • b) • (((a • b))^(-1))  
		 (Overscript[-> , 2]) ((b^(-1)) • (e • b)) • (((a • b))^(-1))  (Overscript[-> , 4]) ((b^(-1)) • (((a^(-1)) • a) • b)) • (((a • b))^(-1))  
		 (Overscript[-> , 6]) (((b^(-1)) • ((a^(-1)) • a)) • b) • (((a • b))^(-1))  (Overscript[-> , 6])  ((((b^(-1)) • (a^(-1))) • a) • b) • (((a • b))^(-1)) 
		 (Overscript[-> , 5]) (((b^(-1)) • (a^(-1))) • a) • (b • (((a • b))^(-1)))  (Overscript[-> , 5])  ((b^(-1)) • (a^(-1))) • (a  • (b  • (((a • b))^(-1))))
		 (Overscript[-> , 6]) ((b^(-1)) • (a^(-1))) • ((a • b) • (((a • b))^(-1)))  (Overscript[-> , II]) ((b^(-1)) • (a^(-1))) • e 
		 (Overscript[-> , I])  (b^(-1)) • (a^(-1))

wherein productions I and II correspond to the former and latter results respectively.

The above solutions, of so neat an appearance, are actually the result of considerable ingenuity in searching for a pattern. In following each derivation we realize that productions (2) and (4) render the automatic generation of the above steps extremely difficult. To appreciate this, consider the following  list of transformations encoding the former axioms:

transf = {
f[x_, e] -> 
            x, 
x_ -> 
            f[x, e], 
f[x_, -x_] -> 
            e, 
f[f[x_, y_], z_] -> 
            f[x, f[y, z]], 
f[x_, f[y_, z_]] -> 
            f[f[x, y], z]};

The function prod below takes an expression x and a transformation t and produces all possible applications of t in x. Function disp provides a better-looking output to their use.

prod[x_ , 
        t_] := {x  /.  t}  /;  Length[x] == 
          0

        
\(\(\(prod[f[x_, \ y_], t_] := 
      Module[{t1, t2, 
          t3}, 
t1 = {f[x, \ y]\  /. \ 
              t}; 
t2 = prod[x, t]; 
t3 = 
          prod[y, \ t]; 
Union[
          t1, \(f[#, y] &\)\  /@ \ t2, \(f[x, #] &\)\  /@ \ t3]]\)\(
\)
    \)\)
disp[x_] := ToString[x]  /;  Length[x] == 0
disp[f[x_,  y_]] := 
      StringJoin["(", disp[x], "•", 
        disp[y], ")"]

prod[f[x, y], 
      (Subscript[transf, [[2]]])]
disp  /@  %

Finally, we generate the first three applications of the rules in transf applied to the expression f(e, x)

t = {f[e, x]};
Do[
t = 
        Complement[Union[Flatten[Outer[prod[#1, #2] &, t, transf], 2]], 
          t]; 
Print[disp  /@  t], {i, 3}]

In the course of this work, a curious question occurred to us: is it possible to furnish the set of prime numbers with a suitable operation so that it becomes a group?. Let us first find a closed commutative operation on this set. We make use of the following result.

Theorem: 	
Let S be an arbitrary set and let (G, * ) be a group. Further, assume S is of the same cardinality than G and let g: S -> G be a bijection. Then (S, •) is a group isomorphic to (G, *) with the operation • defined on S as:

x • y = (g^(-1))( g(x) * g(y) )

Taking the set S to be the set of prime numbers and the set G to be the set of integer numbers we design function g as follows.

SetAttributes[g, Listable]

    
g[p_] := 
      Module[{n = 1}, 
While[
          Prime[n] ≠ p, n++]; 
If[EvenQ[n], 
          n/2, (1 - n)/2]]

g[Prime[Range[20]]]

The inverse of which is:

SetAttributes[gInv,Listable]

gInv[0]:=2
gInv[i_]:=If[Positive[i],Prime[2i],Prime[1-2i]]

gInv[g[Prime[Range[20]]]]

So, the function f we seek is:

f[p1_,p2_]:=gInv[g[p1]+g[p2]]

The corresponding multiplication table starts as follows.

TableForm[Table[f[Prime[i], Prime[j]], {i, 10}, {j, 10}], 
      TableHeadings -> {Prime[Range[10]], Prime[Range[10]]}]

We leave this section with two questions for the reader. How can we design a non-commutative group operation on the set of prime numbers? How do we turn Z into a non-abelian group through finding a suitable operation?

3.- Equivalence Relations

Let us consider the decomposition of a set into disjoint classes  imposed by a given equivalence relation defined on it. We can concisely describe the procedure to obtain these classes by building them up through successively inserting elements as an RS process. Specifically, consider the following set of derivations, which defines a function t that, given a pair {u, v} in the relation, selects the appropriate transformation to perform on a partially constructed set of classes.

t[{u_, 
          v_}] := {{a___, {b___, (u | v), c___}, 
            d___, {e___, (u | v), f___}, 
            g___} -> {a, {b, u, v, c, e, f}, d, 
            g}, 
 {a___, {b___, (u | v), c___}, 
            d___} -> {a, {b, u, v, c}, 
            d}, 
{a___} -> {a, {u, v}}}

Accordingly, we can define function classes which, when given a relation, through mapping each of its elements to t, produces the required set.  

classes[rel_] := 
      Module[{clas = {}}, 
Map[(clas = (clas  /.  
                    t[#])) &,  rel]; 
clas]

relations = {{1, 5}, {6, 8}, {7, 2}, {9, 8}, {3, 7}, {4, 2}, {9, 
            3}};
classes[relations]

4.- Systems of Numeric Productions

Let n be a positive integer, and x and y be arbitrary numbers. Consider the RS:

< n > -> < n - 1 > x  - ‖ n - 1‖ y
‖ n ‖ -> ‖ n - 1 ‖ x + < n - 1 > y
< 0 > -> 1
‖ 0 ‖ -> 0

where the brackets surrounding n are meant to provide two different kinds of contexts and the operations on the right are the usual arithmetic ones. The last two derivations make this system terminating. For instance,

< 2 > -> < 1 > x - ‖ 1‖ y \(TraditionalForm\`\( -> \&*\)\)  x2 - y2

Where the star above the arrow means that we have omitted internal productions involved in this derivation. Let us denote by A ⇒ N the fact that N is a normal form of A.

<< Utilities`Notation`

Notation[<n_> ⟹ b1[n_]]
Notation[\[LeftDoubleBracketingBar]n_\[RightDoubleBracketingBar] ⟹ b2[n_]]

b1[0] := 1
b2[0] := 0
b1[n_] := b1[n] = Expand[b1[n - 1] x - b2[n - 1] y]
b2[n_] := b2[n] = Expand[b2[n - 1] x + b1[n - 1] y]

Table[<j>, {j, 6}]

Table[\[LeftDoubleBracketingBar]j\[RightDoubleBracketingBar], {j, 
        6}]

Theorem

a) < n > ⇒ (∑_(i = 0)^(⌊(n/2)⌋))(((-1))^i)(({{n}, {2  i}}))(x^(n - 2  i))(y^(2  i))

b) ‖ n ‖ ⇒ (∑_(i = 
                0)^(⌊((n - 1)/2)⌋))(((-1))^i)(({{n}, {2  i + 1}}))(x^(n - 2  i - 1))(y^(2  i + 1))

<14>

\[LeftDoubleBracketingBar]15\[RightDoubleBracketingBar]

The following animation shows the complexity of function <n>.

ANIMATION

Map[Plot3D[<#>, {x, -1, 1}, {y, -1, 1}, 
              PlotPoints -> 100, Mesh -> False, 
              Boxed -> False, Axes -> False]; &, 
        Join[Range[15], Range[15, 1, -1]]];

Theorem 	If  <n> ⇒ A and [n] ⇒ B then  A2 + B2 = (x2 + y2)n

Factor[(((<10>))^2) +  (((\[LeftDoubleBracketingBar]10\[RightDoubleBracketingBar]))^2)]

Theorem  	If x=Cos[1], and y=Sin[1]  then

<n> ⇒ Cos[n]  
[n] ⇒ Sin[n]

N[<10> /.  {x -> Cos[1],  
          y -> Sin[1]}]
N[Cos[10]]

The truth of the previous theorems comes from the identity:

(({{  Cos[2  θ]}, { Sin[2  θ]}})  ) = ( ({{Cos[θ], Sin[θ]}, { Sin[θ], Cos[θ]}})) ( ({{ Sin[θ]}, { Cos[θ]}})  )

describing a counterclockwise rotation trough an angle θ around the origin. Using this it can be shown that

(({{<n>}, {[n]}})) ⇒ (((({{x, -y}, {y, x}})))^(n - 1))(({{x}, {y}}))

5.- Recursive Productions

Consider the following rules, invented by the logician Raymond Smullyan:

2X -> X
If  X -> Y then 3X -> Y2Y

smullyan[{"2", X__}] := {X}
smullyan[{"3", X__}] := 
      Module[{Y = smullyan[{X}]}, Join[Y, {"2"}, Y]]

There are novel features in this RS. Those rules are applicable to integers regarded as words built from concatenating digits, but not all integers are "acceptable" words. These rules apply only to words of the form 3n2X for some n≥0 and arbitrary word X. The second rule is posed in a conditional manner in a way that does not resemble any context dependence. It is this rule that allows us to conclude, through a simple application of mathematical induction that:

Theorem

(3^n) 2 X -> (((X 2))^((2^n) - 1)) X

StringJoin  @@  smullyan[Characters["3332456"]]

Also, it is easy to find out that there is a unique word N such that N -> N, that is, the RS admits only one fixed point. More generally, we can assert the following.

Theorem (Fixed Point Theorem)  Given any word A, there exists a word Y such that Y -> AY

For example, if A=332332, then Y=32A3 is such word. This Y might not be unique though, for example, Y=33233 also complies with the theorem for this particular A. A limited converse of the former theorem applies.

Theorem 	Let N= ((((3^n) 2))^m)  (3^n). Then N -> NA with A = (2 (((3^n)))^(m (2^m)  - m - 1))

Proof:	We have that

N= ((((3^n) 2))^m) (3^n) = (3^n) 2 ((((3^n) 2))^(m - 1)) (3^n) -> ((( ((((3^n) 2))^(m - 1)) (3^n)))^((2^n) - 1))((((3^n) 2))^(m - 1)) (3^n) = ((((3^n) 2))^(m((2^n) - 1) + m - 1)) (3^n)

which coincides with the value of the word NA.   ■

Note that not all words have normal forms; among those we can mention words of the form 32n3 for n>1, which have periodic behavior, or of the form 32n32, which have exponential-growth behavior. Moreover we claim that:

Theorem	
A number of the form (Subscript[(((32))^a), 1]) 2 (Subscript[(((32))^a), 2]) 2 ... 2 (Subscript[(((32))^a), n]) 3, where the exponents are non-negative integers and n>0, does not possess a normal form

Proof:	Writing the above form as [a1, a2,…, an] we can deduce that

[a1, a2,…, an]  -> [a1-1, a2,…, an-1, a1+an, a2, …, an]

which proves our claim. ■

We can code this notation as:

Clear[a, b, c, t]

    
t[{a_, b___, c_}] := {a - 1, b, a + c, b, c}
t[{0, b__}] := {b}
t[{a_}] := {2  a - 1}

So that, for example:

NestList[t, {1}, 6]

corresponding to the behavior of the fixed point 323.

NestList[t, {2}, 6]

corresponding to the productions (((32))^2)3 -> (((32))^3)3 -> (((32))^5)3 -> ...

NestList[t, {1, 1}, 6]

corresponding to the productions (((32))^1)2 (((32))^1)3 = 322323 -> 232322323= (((32))^0)2 (((32))^2)2 (((32))^1)3 -> ...

6.- L Systems

Sometimes a useful purpose can be found for RS having no normal form. Consider the L systems (also called Lindenmayer systems or parallel string-rewrite systems) to generate words that can be interpreted by the LOGO turtle (an imaginary graphical entity) in suitable ways as to render eye-catching objects. These systems have not normal forms although they often converge to fractal curves. Although those forms are not reachable in a finite number of steps successive derivations are often intrinsically interesting. An L system is created by starting with an axiom and replacing it through some prescribed productions so that a more complex expression is formed. This expression is assumed to act as LOGO instructions on a starting figure, often a single line segment. 

Assume the symbol F means drawing a unit-length segment forward in the current direction. Assume also that the symbol + conveys a clockwise turn by a fixed angle from the direction we are heading and symbol - a counterclockwise turn by the same amount. Function logo below comprises a very small logo interpreter powerful enough to render striking graphics.

SetOptions[Graphics,  AspectRatio ->  Automatic, 
        PlotRange -> All];

logo[s_String, θ_]:=Module[{a = {0, 0}, b = {1, 0}, h = Cos[θ], 
            k = Sin[θ], t},
t = {a};
Map[Switch[#,"F",AppendTo[t, a = a + b],"+",b=(({{h, -k}, {k, h}})).b,"-",b=(({{h, k}, {-k, h}})).b]& ,Characters[s]];
t]

Take for example the Koch Curve, defined by θ = 60o, the single axiom F and the single production F->F+F—F+F

Koch[s_String] := 
      StringJoin[
        Characters[s]  /.  "F" -> "F+F--F+F"]

NestList[Koch, "F", 2]

logo[Nest[Koch, "F", 2], 60 °]

Show[Graphics[Line[%]]];

In addition to this one, there are other instructive ways of generating Kock curves, one of which is provided by function sF below which sets up the parameters needed for the recursive function snowFlake. Its advantage is that it offers a finer control on the parameters defining this family. Function snowflake's first two parameters correspond to the ends of the generated curve and the last parameter to its order. The reader might find interesting altering the values of the other parameters to find their purpose in generating mutated members of this family.

snowFlake[a_, _, _, _, _, 0] := {a}
snowFlake[a_, b_, λ_, h_, k_, n_]:=Module[{u, v},
u = λ b + (1 - λ) a - a;
v=a+u+(({{h, -k}, {k, h}})).u;
Join[
                snowFlake[a, a + u, λ, h, k, n - 1], 
                snowFlake[a + u, v, λ, h, k, n - 1], 
                snowFlake[v, b - u, λ, h, k, n - 1], 
                snowFlake[b - u, b, λ, h, k, n - 1]]]

sF[θ_, n_] := 
      Append[snowFlake[{0, 0}, {1, 0}, (1/(2 (1 + Cos[θ]))), 
          Cos[θ], Sin[θ], n], {1, 0}]

Show[Graphics[Line[sF[60 °, 4]]]];

ANIMATION

Do[Show[Graphics[Line[sF[n °, 6]]]];, {n, 1. , 360. , 
          10. }];

The Kock curve is often confused with the Osgood curve (see "A Geometrization of Lebesgue's Space-Filling Curve" by H. Sagan in The Mathematical Intelligencer , Vol. 15 num. 4, 1993  pp. 37-43). The code for generating this attractive curve is the following. The reader is advised to try generating this curve for several values of the parameter α, firstly between 0 and 1 and then any real number, even a negative one.

osgood[a_, b_, c_, α_, 1] := 
      Module[{d = a + α (b - a), 
          e = b - α (b - a)}, 
{{RGBColor[
              0.529405,  0.807794,  0.921598], Polygon[{a, c, d}], 
            Polygon[{c, e, b}]}, Line[{a, c, d, a}], 
          Line[{c, e, b, c}]}]

osgood[a_, b_, c_, α_, n_] := 
      Module[{d = a + α (b - a), 
          e = b - α (b - a)}, 
Join[
          osgood[a, c, d, α, n - 1], 
          osgood[b, c, e, α, n - 1]]]

Show[
        Graphics[osgood[{0, 0}, {2, 0}, {1, (Sqrt[3])}, 0.35, 4]]];

ANIMATION

Map[Show[Graphics[osgood[{0, 0}, {2, 0}, {1, (Sqrt[3])}, #, 6]]]; &, 
        Join[Range[-5, 5, 0.1], 
          Range[5, -5, -0.1]]];

Another example of an L system is the Dragon Curve , wherein θ = (90^0) , the axiom is FX and the productions are:

X -> X+YF+
Y-> -FX-Y

In this case the symbols X and Y are ignored when presented to the turtle. Their purpose is to provide the mechanism to “grow” the string to be fed to the turtle.

\(dragon[s_String] := 
      StringJoin[
        Characters[
            s]\  /. \ {"X" -> "X+YF+", "Y" -> "-FX-Y"}]\)

d = 
        logo[Nest[dragon, "FX", 10], 
          80.0  °];
Show[Graphics[Line[d]]];

ANIMATION

Map[Show[
              Graphics[
                Line[logo[Nest[dragon, "FX", 10], #  °]]]]; &, 
        Range[0.0, 360.0, 3.0]];

7.- From Binary Numbers to Compositions

It is well-known the fact that there exist isomorphisms between 1) the set of all subsets of {1, 2, …, n},  2) the first (2^n) binary words starting from (0^n) and ending at (1^n) , 3) the integer numbers from 0 to (2^n)-1 and 4) the compositions of n+1. The table below shows these isomorphisms for the case n=4. We illustrate the use of RS in the translation from a binary word to a composition, that is, given a binary word we will set up an RS in such a way that the normal form to which it converges is the required composition. This is accomplished by the rules

(1^n)0 -> (n+1)+
"+  " -> ""

(note the space after the plus sign in the last production) or equivalently:

10 -> 2+
1x+ -> (x+1)+
0 -> 1+
"+  " -> ""

We will append a 0 at a given binary string before applying these productions. 

For instance, to find out which composition corresponds to the binary sequence 111011 the productions act as follows:

1110110 -> 112+110 -> 112+12+ -> 13+12+ ->  4+12+ → 4+3+ ->  4+3

So, the associated composition is 4+3.

subSets[0] := {{}}
subSets[n_] := 
      Module[{s = subSets[n - 1]}, 
        Join[s, Map[Append[#, n] &, s]]]

    
binary[n_, s_] := 
      Module[{bn = Table[0, {n}]}, 
        (Subscript[bn, [[s]]]) = 1; 
        bn]

    
dec[{}] := 0
dec[{x___, t_}] := 2 dec[{x}] + t

    
compositions[u_] :=  
      Module[{v = 
            Append[u, 
              0]}, 
v = (v  //.   {{a___, 1, 0, 
                    c___} -> {a, 2, "+", 
                    c}, 
{a___, 1, b_, "+", 
                    c___} -> {a, b + 1, "+", 
                    c}, 
{a___, 0, c___} -> {a, 
                    1, "+", c}}); 
StringJoin[
          ToString  /@  Drop[v, -1]]]

n = 4;
m = 
      Map[{#, u = binary[n, #];  StringJoin[ToString  /@  u], dec[u], 
              compositions[u]} &, subSets[n]]  //  MatrixForm

By interpreting the numbers appearing in the last column as distances to be traversed by the LOGO interpreter, we can get a visualization of the set of compositions of a given number. By changing the angular value and/or the parameter n we get a variety of interesting tree-like diagrams.

tr[s_] := 
      StringJoin[
        Flatten[Map[If[# == "+", #, Table["F", {ToExpression[#]}]] &, 
            s]]]

    
n = 8;
m = 
        Map[{#, u = binary[n, #];  StringJoin[ToString  /@  u], dec[u], 
              compositions[u]} &, subSets[n]];
m = Last  /@  m;
u = Map[Characters[Last  /@  #] &, m];
v = Line[logo[tr[#], 72.0 °]] &  /@  
          u;
Show[Graphics[v]];

ANIMATION

Map[(i = #; 
            Show[Graphics[
                Map[Line[logo[tr[#], ((i π)/180.0) ]] & , u]], 
              PlotRange -> {{-8, 9}, {-9, 9}}];) &, 
        Range[0.0, 360.0, 5.0]];

8.- Huffman Coding

In dealing with the storage of a great amount of textual information we face the task of encoding it so that any redundancy in the text can be exploited to our advantage. Dictionaries like the Mexican Spanish Dictionary, a major on-going project that started about twenty years ago at El Colegio de Mexico, a prestigious research institution in Mexico City, faced this important challenge. The author was then a member of the team that suggested, implemented and tested a variety of approaches to alleviate the computational burden of dealing with massive amounts of textual information when we came across the fact that the optimal way to accomplish the compression that exploits the inherent redundancy in any discrete interchange of information was already discovered by D.Huffman and reported on his paper "A Method for the construction of minimum-redundancy codes" at the Proceedings of the IRE, vol.40, 1952.

Huffman coding involves the building of a tree of frequencies of each of the symbols forming the original message. Once this tree is constructed, the leave nodes can be coded to a binary specification of the path needed to reach them from the root.

The details are now part of the standard content of any undergraduate course on algorithm design and here we want to illustrate the application of transformational grammars, as RS are called in this context, to this type of problems (for an alternative way of implementing run-length encoding consult Version 3.0 Programming Features by Roman Maeder, the Mathematica Journal vol.6 issue 4, Fall 1996, p. 40-43). First we design function frequencies to count the frequencies of the symbols appearing in a given sentence.

frequencies[mesg_String] := 
      With[{m = 
            Characters[mesg]}, 
({#, Count[m, #]} &) /@ 
          Union[m]]

message = "Hi there, glad you could make it";
frequencies[message]

or, alternatively

\(runEncode[mesg_String] := 
      Map[{#, \ 1}\  &, \ 
\ \ \ \ \ \ Characters[
            mesg]]\  //. {x___, {a_, \ i_}, \ y___, {a_, \ j_}, 
            z___}\  -> \ {x, \ {a, \ i\  + \ j}, \ y, \ z}\)

runEncode[message]

We use nested lists for the encoding of trees; for instance, the tree

is represented by the list: 

t = {Root, {12, {5, {6, "beta"}}, "alpha", 
            28, {11, {4, 7}}}};

We also need function sons to obtain all the sons of a given tree:

sons[s_] := s
sons[{a___, {b_, c__}, d___}] := sons[{a, b, d}]

sons[Last[t]]

We will consider only numeric trees representing the frequencies of their respective words. We now set up the patterns comprising the Huffman algorithm. All of them implement one step of the iterative process which will build the Huffman tree. This process can be described as follows. Given the two smallest elements x, y of a list, we encapsulate them to form a subtree labeled x+y.

patterns[x_, 
        y_] := {{a___, x, b___, y, c___} | {a___, y, b___, x, 
              c___} -> {a, b, {x + y, {x, y}}, c}, {a___, {x, t__}, 
            b___, {y, g__}, c___} -> {a, b, {x + y, {{x, t}, {y, g}}}, 
            c}, {a___, {y, t__}, b___, {x, g__}, c___} -> {a, 
            b, {x + y, {{y, t}, {x, g}}}, c}, {a___, {x, t__}, b___, y, 
            c___} -> {a, b, {x + y, {{x, t}, y}}, c}, {a___, {y, t__}, 
            b___, x, c___} -> {a, b, {x + y, {{y, t}, x}}, c}, {a___, x, 
            b___, {y, g__}, c___} -> {a, b, {x + y, {x, {y, g}}}, 
            c}, {a___, y, b___, {x, g__}, c___} -> {a, 
            b, {x + y, {y, {x, g}}}, c}}

using those transformations in processing the given vector of frequencies we arrive at function huffman.

huffman[frec_] := 
      Module[{x, 
          y}, 
FixedPoint[({x, y} = 
                Take[Sort[sons[#]], 2]; # /. patterns[x, y]) &, frec, 
          Length[frec] - 1]]

huffman[{20, 28, 4, 17, 12, 7}]

The successive steps of the process to arrive at this result are the following:

To recover the original labels, i.e., substitute the numerical labels for their original characters at the leaves nodes, we need to apply rewriting on the Huffman tree. Function lettersTree below receives a sentence, obtains its frequencies, obtains its Huffman tree and performs this rewriting.

lettersTree[mesg_] := 
      Module[{f = frequencies[mesg], t, i, j, k, p, q, x, y, 
          z}, 
t = 
          First[huffman[Last /@  f]]; 
t = 
          t  //.  {i_Integer, {x___, j_Integer, y___}} -> {i, {x, 
                  j + 0.1, y}}; 
While[
          f ≠ {}, 
{i, j} = 
            First[f]; 
p = 
            First[Position[t, j + 0.1]]; 
t = 
            ReplacePart[t, i, p]; 
f = 
            Rest[f]]; 
t]

t1 = lettersTree[message]

Which corresponds to the tree (Note the blank space at the leftmost node):

Finally, function huffmanCode below computes the code that will minimize the codification of a given message.

huffmanCode[mesg_] := 
      Module[{t = lettersTree[mesg], h, u}, 
u = 
          Cases[Flatten[
              t], _String]; 
h = (Position[t, #1] &) /@ 
            u; 
h = #[[
                Range[2, Length[#], 2]]] & /@ 
            Flatten[h, 
              1]; 
c = (StringJoin[
                  ToString /@ #1] &) /@ (h /. {1 -> 0, 
                  2 -> 1}); 
Thread[
          u -> c]]

mesg = "hi there";
huffmanCode[mesg]

The actual codified message is:

StringReplace[mesg, %]

As a final example, consider the following excerpt from Carlos Fuentes´ Terra Nostra:

m = "El cielo abovedado se abrió en la siguiente grada: \
se desintegró la luz metálica; pero el paso de las \
ráfagas de viento y de las luces encontradas, resueltas en \
glóbulos de color puro jamás visto, en triángulos de \
fuego y columnas de fósforo, en bloques de asombro total y espirales \
enigmáticas, impedia ubicarse en ese espacio total, fugitivo e \
infinito, sin principio ni fin.";

    
huffmanCode[m]