Context-Free Languages: Chomsky Normal Form

By

Jaime Rangel-Mondragón
jrangel@sunserver.uaq.mx

Copyright © December 2000, UAQ, Facultad de Informática

Permission is hereby granted to reproduce part or all of this file for any purpose other than direct profit providing that the source is acknowledged.

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.

From many points of view, the class of context-free languages (CFL) is certainly among the most interesting formal languages; these languages have undergone a substantial amount of research due mainly to their abundant applications. CFL can be represented either by grammars or as push-down automata. In this work we provide functions dealing with the first of those representations and leave utilizing the advantages provided by the second one to future work.
In Chomsky Normal Form (CNF) each production of the grammar is of the type A->BC or of the type A->x, where A, B, and C are arbitrary non-terminals and x a terminal symbol. Further, we do not have useless symbols, that is, symbols that do not derive terminal words and/or are not reachable from the start symbol. Also, we may lose ε (empty word). The CNF allows us to systematically study CFL and facilitates the analysis of important results like the fact that it is decidable whether or not an arbitrary word belongs to a given CFL or the Pumping Lemma for CFL , which establishes fundamental limitations in the generative power of CFL.

In order to be able to input and output grammars in Backus-Naur Form while manipulating them as lists we use functions pairs and BNF

prod[{nT_, "-", p__}] := {{nT, 
          StringJoin[p]}}
prod[{nT_, "-", p__, "|", q__}] := 
      Join[prod[{nT, "-", p}], 
        prod[{nT, "-", q}]]

pairs[G_] := 
      Flatten[Map[prod[Characters[#]] &, G], 
        1]

bars[{x_}] := x
bars[{x_, y__}] := x <> "|" <> 
        bars[{y}]

BNF[G_] := 
      Map[First[#] <> "-" <> bars[Rest[#]] &, 
        G   //.  {x___, {A_, B__}, y___, {A_, C__}, 
              z___} -> {x, {A, B, C}, y, z}]

The following constitute a sample of test grammars that we will use to illustrate the actions of all our functions.

\(\(G1 = 
        pairs[{"S-ABbaDS|S|Cb|A|C|aJ", "A-S|BC|b|F|ε", "B-ac", "B-ac|ac", "C-S|D", "E-abS|cc", "F-A", "G-H|H|G", "H-G|I|H|abc", "J-J"}];\)\)
\(\(G2 = 
        pairs[{"S-a|Xb|aYa", "X-Y|ε", "Y-b|X"}];\)\)
G3 = pairs[{"S-SS|AB|b", "B-SB|b", "A-a"}];
G4 = pairs[{"S-aSa|bSb|ε"}];
\(\(G5 = 
        pairs[{"S-a|Xb|aYa", "X-Y|ε", "Y-b|X"}];\)\)
\(\(G6 = 
        pairs[{"S-XY", "X-Zb", "Y-bW", "Z-AB", "W-Z", "A-aA|bA|ε", "B-Ba|Bb|ε"}];\)\)
G7 = 
        pairs[{"S-Xab|YY|aX|ZYX", "X-Za|bZ|ZZ|Yb", "Y-Ya|XY|\
ε", "Z-aX|YYY"}];
G8 = pairs[{"S-A|bb", "A-B|b", "B-S|a"}];
\(\(G9 = 
        pairs[{"S-XY", "X-XX|A", "Y-YY|B", "A-a", "B-b"}];\)\)
G10 = 
        pairs[{"S-aSa|bSb|a|b|ε"}];
G11 = 
        pairs[{"S-bA|aB", "A-bAA|aS|a", "B-aBB|bS|b"}];
G12 = pairs[{"S-aaaaS|aaaa"}];
G13 = 
        pairs[{"S-ABABA", "A-a|ε", "B-b|\
ε"}];
G14 = pairs[{"S-SS|a"}];
G15 = 
        pairs[{"S-SS|AB|b", "B-SB|b", "A-a"}];
G16 = 
        pairs[{"S-(S)|(S*S)|(S+S)|(S-S)|(S/S)|(a)|(b)"}];

Note that we use (and require in all this work) the symbol S for the starting symbol. For instance, consider the following example of the difference between the list-of-pairs and BNF representations:

G1
BNF[G1]

Conversion to Chomsky Normal Form

We reach this form in several steps corresponding to general reductions.

Removal of useless symbols and productions: Either because they are unreachable from S or they do not produce non-terminals (redundant A → A type also)

reachableNT[G_] := 
      Module[{marked = {"S"}}, 
FixedPoint[
          Function[m, 
            Map[(Cases[
                    G, {#, x_} :> 
                      AppendTo[marked, 
                        Select[Characters[x], UpperCaseQ]]]) &, 
              m]; 
Union[Flatten[marked]]], 
          marked]]

terminatingNT[G_] := 
      Module[{t, g, h, marked = {}, u, v}, 
FixedPoint[
          Function[g, 
            t = First  /@  
                Select[g, 
                  Not[UpperCaseQ[Last[#]]] &]; 
AppendTo[
              marked, t]; 
h = 
              Select[g, 
                Not[MemberQ[t, First[#]]] &] ; 
Map[({u, 
                      v} = #; 
{u, 
                    StringJoin[
                      Characters[v] /.  
                        Map[(# ->  "a") &, t]]}) &, h]], 
          G]; 
Union[
          Flatten[marked]]]

eliminateUseless[G_] := 
      Module[{t, allV, G1, nT}, 
FixedPoint[
          Function[g, 
            allV = Union[
                Select[Flatten[Map[{First[#], Characters[Last[#]]} &, g]], 
                  UpperCaseQ]]; 
G1 = 
              DeleteCases[g, {x_, x_}]; 
t = 
              terminatingNT[G1]; 
nT = 
              Complement[allV, t]; 
 
            Select[G1, (MemberQ[reachableNT[G1] ⋂ t, 
                      First[#]]  &&  (Characters[Last[#]] ⋂ 
                          nT == {})) &]], Union[G]]]

When we arrive at the last stage it might occur that we cannot reach some variables that were reachable before- because they appear together with unreachable ones. That is why we had to use FixedPoint.

BNF[G16]
reachableNT[G16]
terminatingNT[G16]
BNF[eliminateUseless[G16]]

BNF[G1]
reachableNT[G1]
terminatingNT[G1]
BNF[eliminateUseless[G1]]

There can be other simplifications. For instance, the grammar {"S-aA|B","A-b","B-b"} is equivalent to the grammar {"S-aA|b"}, however, the former is not equal (equivalent) to {"S-aA|Bb","A-b","B-b|S"}.  Also, the grammar {"S-aA|B","A-ε","B-aA"} is equivalent to {"S-aA|a"}. We can say in general that, if we can spot two non-terminals generating the same language, they can be identified in the grammar they are part of; often this constitutes a substantial  simplification. In general, however, it is undecidable to test two grammars for equality.

Identification and removal of ε-productions (processing of nullable non-terminals)

nullables[G_] := {}  /;  
        Cases[G, {_, "ε"}] == {}
\(nullables[G_] := 
      Module[{u, v, nul = Cases[G, {X_, "ε"} -> X], 
          filteredG = 
            Select[G, UpperCaseQ[Last[#]] &]}, 
FixedPoint[
          Function[nu, 
            Union[Flatten[{nu, 
                  Cases[Map[\(({u, v} = #; {u, 
                            StringReplace[v, 
                              Map[\((# -> "")\) &, 
                                nu]]})\) &, 
filteredG], {X_, ""} -> \ X]}]]], nul]]\)

nullables[G1]
nullables[G2]
nullables[G3]
nullables[G4]
nullables[G5]
nullables[G6]
nullables[G7]
nullables[G8]
nullables[G9]
nullables[G10]
nullables[G11]
nullables[G12]
nullables[G13]

Passing Comment: Collatz´s problem illustrating the action of Map. Compare the following two inputs. Map is not dynamically changed as it traverses its argument

s = {243};
\(\(Map[AppendTo[s, If[EvenQ[#], #\/2, 3\ # + 1]] &, 
        s];\)\)
s

i = 1;
s = {243};
While[(i ≤ Length[s]) && (Last[s] > 
              1), 
AppendTo[s, 
          If[EvenQ[s[[i]]], 
            s[[i]]/2, 
            3 s[[i]] + 
              1]]; i++];
s

We will need to generate all subsets of a given set:

subS[{}] := {{}}
subS[{x_, t___}] := 
      Module[{s = subS[{t}]}, Join[s, Map[Join[{x}, #] &, s]]]

subS[{a, 1, z}]

myStringDrop[s_, {x_}] := StringDrop[s, {x}]
myStringDrop[s_, {x_, y__}] := 
      StringDrop[
        myStringDrop[
          s, {y}], {x}]

eliminateNullables[G_] := 
      Module[{nul = nullables[G], s, liveProd, step1, step2, u, v, w, 
          i}, 
If[nul == {}, 
          Return[G]]; 
liveProd = 
          Select[G, (Characters[Last[#]] ⋂ 
                    nul ≠ {}) &]; 
step1 = 
          Map[({u, v} = #; 
                s = {}; 
Do[
If[
                    MemberQ[nul, StringTake[v, {i}]], AppendTo[s, i]], {i, 
                    StringLength[v]}]; 
{u, v, 
                  Rest[subS[s]]}) &, liveProd]; 
step2 = 
          Map[({u, v, 
                    w} = #; 
Map[{u, myStringDrop[v, #]} &, 
                  w]) &, step1]; 
Union[
          DeleteCases[
            Join[G  /.  "ε" ->  "", 
              Flatten[step2, 
                1]], {_, ""}]]
]

BNF[G6]
nullables[G6]
BNF[eliminateNullables[G6]]

Note that for G2, function BNF produces  Y-Y

Removal of unit productions from an ε-free grammar (it might generate useless symbols)

g[s_] := 
      Module[{p = {}, 
          f}, 
f[{___, {A_, B_}, ___, {B_, C_}, ___}] := 
          1  /;  (A ≠ C) &&  AppendTo[p, {A, C}]  &&  
              False; 
f[{___, {B_, C_}, ___, {A_, 
                B_}, ___}] := 
          1  /;  (A ≠ C) &&  AppendTo[p, {A, C}]  &&  
              False; 
f[s]; 
Union[s, 
          p]]

transitiveClosure[s_] := 
      FixedPoint[g, s]

eliminateUnit[G_] := 
      Module[{p, unitP, G2 = G, u, v}, 
p = 
          Select[G, (StringLength[Last[#]] == 1) && (UpperCaseQ[
                    Last[#]]) &]; 
unitP = 
          transitiveClosure[
            DeleteCases[
              p, {x_, x_}]]; 
Map[({u, 
                  v} = #; 
G2 = 
                Join[G2, Cases[G, {v, x_} ->  {u, x}]]) &, 
          unitP]; 
Union[
          Select[G2, ((StringLength[Last[#]] > 1) || 
                  Not[UpperCaseQ[Last[#]]]) &]]]

\(transitiveClosure[{{"S", "X"}, {"S", "Y"}, {"S", "t"}, {"X", "Z"}, {"Y", "a"}, {"Z", "Y"}}]\)

BNF[eliminateUnit[G8]]

BNF[eliminateUnit[G9]]

BNF[eliminateUseless[eliminateUnit[G9]]]

BNF[G7]
u = eliminateNullables[G7];
BNF[u]
BNF[eliminateUnit[u]]

To examine the effect of  applying eliminateUseless before or after applying the other eliminations:

BNF[G1]
u = eliminateNullables[G1];
BNF[u]
v = eliminateUnit[u];
BNF[v]
BNF[eliminateUseless[v]]
u = 
        eliminateNullables[
          eliminateUseless[G1]];
BNF[u]
BNF[eliminateUseless[eliminateUnit[u]]]

Separation of terminals and non-terminals in unit-productions-less grammars

separate[G_] := 
      Module[{allNT, newNT, t, G1, tr, u, v}, 
allNT = 
          Union[Select[Flatten[Map[{First[#], Characters[Last[#]]} &, G]], 
              UpperCaseQ]]; 
newNT = 
          Complement[CharacterRange["A", "Z"], 
            allNT]; 
t = 
          Union[Select[Flatten[Map[Characters[Last[#]] &, G]], 
              Not[UpperCaseQ[#]] &]]; 
s = 
          Thread[{Take[newNT, Length[t]], t}]; 
tr = 
          Map[(First[#] ->  Last[#]) &, 
            Reverse  /@  s];  
G1 = 
          Map[({u, v} = #; 
If[
                  Not[UpperCaseQ[v]] && (StringLength[v] > 1),  {u, 
                    StringReplace[v, tr]}, #]) &, 
            G]; 
eliminateUseless[Join[G1, s]]]

G = 
        pairs[{"S-XY", "X-XX|a", "Y-YY|b"}];
BNF[separate[G]]

BNF[G1]
BNF[separate[G1]]

BNF[separate[G10]]

Chomsky Normal Form

chomsky[G_] := 
      Module[{g, allNT, newNT, u, v, i, t, r, 
          ans = {}}, 
g = 
          separate[
            eliminateUseless[
              eliminateUnit[
                eliminateNullables[G]]]]; 
allNT = 
          Select[Flatten[Map[{First[#], Characters[Last[#]]} &, g]], 
            UpperCaseQ]; 
newNT = 
          Complement[CharacterRange["A", "Z"], 
            allNT]; 
i = 
          1; 
Map[
({u, 
                  v} = #; 
ans = 
                Join[ans, 
                  If[Not[UpperCaseQ[v]] || (StringLength[v] == 
                          2), {#}, 
t = 
                      Take[newNT, {i, 
                          i + StringLength[v] - 3}]; 
i = 
                      i + StringLength[v] - 2; 
r = 
                      Append[StringJoin  /@  
                          Thread[{Characters[StringDrop[v, -2]], t}], 
                        StringTake[
                          v, -2]]; 
Thread[{Join[{u}, 
                          t], r}]
]]) &, 
          g]; 
ans]

BNF[chomsky[G9]]

BNF[chomsky[G10]]

BNF[chomsky[G11]]

BNF[chomsky[G13]]

BNF[chomsky[G14]]

BNF[chomsky[G15]]

BNF[chomsky[G16]]

Word Recognition

The context-free recognition problem for a given CFG is to decide whether or not S \(TraditionalForm\`\( -> \&*\)\) w for a given word w of terminal symbols. Function genQ[G,w] is a predicate testing whether w belongs to the language accepted by grammar G.

\(genQ[G_, word_] := 
      Module[{NT, T, 
          generatedQ}, 

generatedQ[A_, 
            w_] := \((generatedQ[A, w] = MemberQ[T, {A, w}])\)\  /; \ 
            StringLength[w] == 1; 
generatedQ[A_, 
            w_] := \(generatedQ[A, w] = 
            Module[{p, B, C, children = {}, n = StringLength[w], 
                i}, 
p = 
                Cases[NT, {A, _}]; 
Map[\(({B, C} = 
                      Characters[Last[#]]; 
Do[
                      AppendTo[
                        children, {{B, StringTake[w, i]}, {C, 
                            StringTake[w, i - n]}}], {i, n - 1}])\) &, 
                p]; 
i = 
                1; 
While[\((i ≤ 
                      Length[children])\) && 
                  Not[Apply[generatedQ, 
                        First[children[[
                            i]]]]\  && \ 
                      Apply[generatedQ, 
                        Last[children[[
                            i]]]]], \(i++\)]; 
Not[
                i > Length[
                    children]]]\); 

NT = 
          Select[G, 
            StringLength[Last[#]] == 2 &]; 
T = 
          Complement[G, NT]; 
generatedQ["S", 
          word]]\)

Note in passing:

x = 
        If[False  &&  (1/0), True, False];
y = If[True || (1/0), True, False];
{x, y}

genQ[G15, "aabbb"]

G = chomsky[G10];
BNF[G]
genQ[G, "aba"]

G = chomsky[G16];
BNF[G]
genQ[G, "(a)"]

To generate all words of a fixed length in a given alphabet:

allWords[s_, n_] := 
      Module[{i, l = Length[s]}, 
        Flatten[Table[
            StringJoin[
              IntegerDigits[i, l, n]  /.  
                Thread[Range[0, l - 1] ->  s]], {i, 0, 
              (l^n) - 1}]]]

allWords[{"a", "b", "c"}, 3]

\(allWords[{"a", "b", "(", ")", "+", "-", "*", "/"}, 2]\)

So, we can select all words of a given size accepted by a given CFG:

Select[allWords[{"a", "b"}, 3], genQ[G15, #] &]

Select[allWords[{"a", "b"}, 6], genQ[G15, #] &]

\(Select[
      Select[allWords[{"a", "b", "(", ")", "+", "-", "*", "/"}, 3], StringMatchQ[#, "*(*)*"] &], 
      genQ[chomsky[G16], #] &]\)

\(Select[
      Select[allWords[{"a", "b", "(", ")", "+", "-", "*", "/"}, 5], StringMatchQ[#, "*(*)*"] &], 
      genQ[chomsky[G16], #] &]\)

Word Parsing

In a CFG there is no bound on the size of a right-side production. In a CNF no grammatical tree has more than a binary branching. To parse a given word means to find any sequence of productions leading to the actual generation of the word. Function parse below provides this list.

\(parse[G_, word_] := 
      Module[{NT, T, 
          parsing}, 

parsing[A_, 
            w_] := \((parsing[A, w] = 
                If[MemberQ[
                    T, {A, w}], {StringJoin[A, " -> ", 
                      w]}, {}])\)\  /; \ \ StringLength[w] == 
              1; 

parsing[A_, 
            w_] := \(parsing[A, w] = 
            Module[{p, B, C, children = {}, n = StringLength[w], i, u, 
                v}, 
p = 
                Cases[NT, {A, _}]; 
Map[\(({B, C} = 
                      Characters[Last[#]]; 
Do[
                      AppendTo[
                        children, {{B, StringTake[w, i]}, {C, 
                            StringTake[w, i - n]}}], {i, n - 1}])\) &, 
                p]; 
i = 
                1; 
While[\((i ≤ 
                      Length[children])\) && 
                  Not[u = 
                      Apply[parsing, 
                        First[children[[
                            i]]]]; 
v = 
                      Apply[parsing, 
                        Last[children[[
                            i]]]]; \((u ≠ {})\)\  && \ \((v ≠ {})\)], \(i++\)]; 
If[
                Not[i > Length[children]], 
                Join[{StringJoin[A, " -> ", 
                      First\  /@ \ 
                        children[[i]]]}, 
                  u, v], {}]]\); 

NT = 
          Select[G, 
            StringLength[Last[#]] == 2 &]; 
T = 
          Complement[G, NT]; 
parsing["S", 
          word]]\)

G = chomsky[G10];
BNF[G]
parse[G, "abbaabba"]

parse[G, "bab"]

Map[Print[#, "  ", parse[G15, #]] &, 
        Select[Flatten[Table[allWords[{"a", "b"}, i], {i, 6}]], 
          genQ[G15, #] &]];

To find out the length of the parsings as the length of the word increases:

t = 
        Map[Length[parse[G15, #]] &, 
          Select[Flatten[Table[allWords[{"a", "b"}, i], {i, 10}]], 
            genQ[G15, #] &]];
ListPlot[t,  PlotJoined ->  True];

Diagrams

Fish diagrams (Turtle graphics on a 2-symbol alphabet grammar in CNF)

In order to obtain a graphical representation of a CFG we propose what we call "fish diagrams". Symbol "a" means one unit step in the current direction. Symbol "b" means turn a given angle θ anti-clockwise

showG[s_, θ_] := 
      Module[{t = 0, p = {{0, 0}}}, 
Map[
          If[# == "a", 
              AppendTo[p, Last[p] + {Cos[t °], Sin[t °]}], 
              t = t + θ ] &, Characters[s]]; 
Line[
          p]]

Do[
w = 
        Select[allWords[{"a", "b"}, n], genQ[chomsky[G10], #] &];  
      Print[w]; 
Show[Map[Graphics[showG[#, 30]] &, w], 
        AspectRatio ->  Automatic];, {n, 3, 10}]

Directional graphics on a 4-symbols alphabet grammar in CNF

An alternative graphical representation

showG[s_] := 
      Module[{p = {{0, 0}}}, 
Map[
          AppendTo[p, 
              Last[p] + 
                Switch[#, "a", {1, 0}, "b", {0, 
                    1}, "c", {-1, -1}, "d", {1, -1}]] &, 
          Characters[s]]; 
{Line[p], 
          Disk[Last[p], 0.1]}]

G = 
        chomsky[pairs[{"S-aA|bB|cA|dB|ε", "A-bSa|a|\
ε", "B-aSb|ε"}]];
Do[
w = 
        Select[allWords[{"a", "b", "c", "d"}, n], 
          genQ[G, #] &];  
      Print[w]; 
Show[Map[Graphics[showG[#]] &, w], 
        AspectRatio ->  Automatic];, {n, 6}]