Grammatiken

Wir zeigen hier, wie man mit Mathematica den Ersetzungsmechanismus von Grammatiken nachbilden kann.

Die Ersetzungsregel einer Grammatik kann man recht einfach mit den Ersetzungsregeln von Mathematica nachbilden. Wir werden hier die Funktion StringReplace dazu nutzen. Als erstes, zum Einstieg sozusagen, werden wir uns dem Problem so nähern, wie man es in der “klassischen” Programmierung, etwa in Java oder C, tun würde. Wir werden dann aber sehr schnell die Mächtigkeit der Mathematica-eigenen Befehle sehen, mit denen das o.g. Problem recht schnell “erschlagen” werden kann.

Regeln werden wir ganz einfach als Ersetzungsregeln definieren:

r1= "S"-> "AS"; r2= "S"->"SB";r3="B"->"b";rules={r1,r2,r3}

Der Ersetzungsmechanismus kann also direkt angewandt werden:

StringReplace["S",r1]

Oder noch einfacher:

"S" /. r1

Die Anwendung mehrerer Ersetzungen hintereinander ist auch kein Problem, da StringReplace auch eine Liste von Ersetzungen annehmen kann:

"S" /. {{"S"-> "SA"},{"S"-> "SS"},{"S"-> "BA"}}

Allerdings ist das nicht ganz das was wir hier brauchen, schließlich soll die zweite Ersetzung ja auf den String angewandt werden, der als Ergebnis der ersten Ersetzung entstanden ist. Dies ist mit der Funktion ReplaceAll (/.) nicht soeinfach zu bewerkstelligen, da nach der ersten Ersetzung ja der String “SA” vorliegt, auf den die Regel “S”->”SS” keine Wirkung hat. Mit StringReplace ist dies jedoch problemlos möglich:

start="S";rules = {{"S"-> "SA"},{"S"-> "SS"},{"S"-> "BA"}};

Do[{start = StringReplace[start, rules[[i]]] },{i,1,Length[rules]}]; start

Nun kann man recht leicht ermitteln, wie das Ergebnis der, sagen wir mal dreifachen, Anwendung der Regeln auf das Startsymbol ”S” ist. Zunächst besorgen wir uns alle Möglichkeiten die Regeln anzuwenden, was mit der Funktion Tuples recht einfach ist.

replace=Tuples[{r1,r2,r3},3]

Jede dieser Möglichkeiten muß nun auf das Startsymbol angewandt werden. Zuvor muß jedoch jede einzelne Ersetzungsregel in eine Liste quasi eingepackt werden, um die Funktion StringReplace später einfacher anwenden zu können. Kein Problem:

replaceList =Map[List[#]& , replace,{2}];

Der hier angegebene Parameter {2} bewirkt, daß der Befehl auf die Listenelemente der Ebene 2 angewendet werden. Zur Anwendung dieser Ersetzungslisten verwenden wir eine Funktion die jede Ersetzungsliste auf das Startsymbol anwendet

ersetzen[start_, ersetzungen_List]:= Module[{ersetzung,limit=Length @ ersetzungen, temp,j,out={}},
Do[{ersetzung=ersetzungen[[i]];
temp=start;
Do[temp=StringReplace[temp,ersetzung[[j]]],{j,1,Length[ersetzung]}];
out=AppendTo[out,temp];
},{i,1,limit}
];
out//Union]

Nun kann man mal nachsehen, ob das auch so funktioniert, wie man sich das vorstellt:

start="S";ersetzen[start,replaceList]

Das sieht zwar im Ergebnis gut aus, aber der Code ist nicht gerade Mathematica-like. Der wesentliche Nachteil ist, daß man die mächtigen iterativen Funktionen von Mathematica, wie etwa Nest und NestList, hier nicht ohne Weiteres einsetzen kann. Mathematica besitzt mächtige Funktionen, die hier viel besser eingesetzt werden können als obiger iterativer Ansatz.

Die Zahl der möglichen Ersetzungen wächst nun mal eben exponentiell. Aber das ist nicht das einzige Problem. Wir arbeiten hier mit Regeln, brauchen aber eigentlich Strings. Dieser Nachteil kann aber leicht behoben werden, indem wir generell mit Strings arbeiten. Was wollen wir eigentlich? 
Auf einen Startstring, oder eine Menge von solchen Strings, soll eine Reihe von Ersetzungsregeln angewendet werden. Mehr nicht. Also brauchen wir nur eine Funktion, die eine Liste von Regeln auf eine Menge von Strings anwendet. Nichts leichter als das, wir brauchen dazu nicht einmal zu programmieren, alles was wir brauchen bringt Mathematica bereits mit, nämlich die Funktion StringReplaceList. Vor der Anwendung müssen wir nur die Regelmenge wieder in eine einfache Liste zurückverwandeln, sonst hagelt es bei StringReplaceList nur Fehlermeldungen.

rules = Flatten@rules;StringReplaceList["S",rules]

Das Schöne daran ist, daß das auch mit Listen von Startstrings geht:

StringReplaceList[{"ASB","ASBB",""},rules]

Das Einzige was noch zu tun bleibt ist, die für jedes einzelne “Startelement” einer Liste enthaltenen Ergebnisse zusammenzufasen. Die Funktion

Union @ Flatten@ StringReplaceList[{"ASB","ASBB",""},rules]

liefert das Gewünschte. Jetzt ist es einfach, ausgehend von einem Startsymbol “S”, die n-fache Anwendung einer Regelmenge zu simulieren. Hier die dreifache Anwendung der Regelmenge rules auf das Startsymbol:

ergebnis = NestList[Union[Flatten[StringReplaceList[#,rules]]]&,{"S"},4] // Flatten

Length@ergebnis

Die Auswahl der Terminalsymbole kann nun einfach dadurch realisiert werden, in dem alle Großbuchstaben ausgefiltert werden (was in diesem Falle natürlich vom Ergebnis her klar ist):

Select[ergebnis,LowerCaseQ]

Letztlich brauchen wir das Ergebnis nur noch zu einer einfachen Funktion zusammenzufassen, um die entsprechenden Regeln einer Grammatik einfach anwenden zu können.

produktion[start_List,regeln_List,n_Integer]:=
Flatten[NestList[Union[Flatten[StringReplaceList[#,regeln]]]&,start,n]]

produktion[{"S"},rules,2]

Nun ist es auch in einfacher Art und Weise möglich direkt die Produktionen einer Grammatik zu verifizieren. Hier das einfache Beispiel einer Grammatik, welche die Sprache L={(a^n)(b^n)| n∈ℕ} erzeugt:

klassiker={"S"-> "ASB", "S"-> "", "A"-> "a", "B"-> "b"};

results = Table[Select[produktion[{"S"},klassiker,n],LowerCaseQ],{n,5,10}];

results // TableForm

Natürlich kann man nicht immer mit LowerCaseQ arbeiten, um die Terminalstrings zu erhalten, das geht immer dann nicht, wenn Sonderzeichen Bestandteil des (Terminal-) Alphabets sind. Wie im nächsten Beispiel, das wir betrachten.

Einfache arithmetische Ausdrücke

Die folgende Grammatik erzeugt (ganz) einfache arithmetische Ausdrücke etwa der Form (x+y)*z. Die Anzahl der erzeugten Strings wächst hier natürlich sehr stark, da die Grammatik viel mehr Produktionen enthält als der zuvor betrachtete “Klassiker”.

arithmetik={"S"-> "S+S", "S"-> "S*S", "S"-> "(S)", "S"-> "E", "E"->"x", "E"-> "y", "E"-> "z"}

{"S"->"S+S","S"->"S*S","S"->"(S)","S"->"E","E"->"x","E"->"y","E"->"z"}

Die Menge an produzierten Strings ist schon bei fünf Iterationen recht ordentlich:

start={"S"}; results =produktion[start,arithmetik,5];

Length @ results

Fünf Iterationen liefern also bereits 2775 Strings. Um nun diese Strings herauszufiltern, die aus Terminalzeichen bestehen müssen wir erst noch eine geeignete Funktion definieren, die wir dann an die Select Funktion von Mathematica weitergeben. Als Terminalalphabet haben wir:

terminals = {"x","y","z","(",")","*","+"}

Die Funktion inAlphabetQ leistet das Gewünschte, sie prüft einfach ab, ob ein erzeugter String noch Zeichen enthält, die nicht in der Menge der Terminalsymbole liegen:

inAlphabetQ[string_,alphabet_]:=Complement[Characters[string],alphabet]=={}

Die Funktion inAlphabetQ kann einfach überprüft werden:

string="x+y"; inAlphabetQ[string, terminals]

string="E+x"; inAlphabetQ[string, terminals]

Damit können wir in einfacher Art und Weise die Terminalstrings aus dem oben erzeugten (aber nicht angezeigten) Resultat result anzeigen:

Select[results,inAlphabetQ[#,terminals]&]

Bereits bei fünf Iterationen werden insgesamt 30 Terminalstrings erzeugt:

Length @ %

Es ist nun recht einfach die Anzahl der Terminalstrings zu bestimmen, die für eine gewisse Anzahl von Iterationen erzeugt werden. Ich mache das hier einmal für fünf bis neun Iterationen:

res = Table[Select[produktion[start,arithmetik,i],inAlphabetQ[#,terminals]&],{i,5,9}];

anzahlProduktionen = Length /@ res

Wie man sieht steigt die Anzahl der Produktionen stark an:

lp=ListPlot[anzahlProduktionen,PlotStyle->{ Blue ,PointSize[0.01]}, DataRange->{5,9}]

Als nächstes untersuchen wir das Wachstum der Anzahl der erzeugten Terminalstrings. Die Art des Wachstums legt (natürlich) ein exponentielle Wachstum nahe. Überprüfen wir das:

approx = FindFit[anzahlProduktionen,a (E^(b x)),{a,b},x]

func[x_]:=a (E^(b x)) /.approx;

data ={Range[5,9],anzahlProduktionen}\[Transpose]

Plot[func[x-4.],{x,5,10}, PlotStyle->Red,PlotLabel->Text[Style["Anzahl der erzeugten Strings", Bold]],Epilog->{Blue,PointSize[Medium], Point[data], PlotRange-> All} 
]

In der Tat, erwartungsgemäß liegt ein (ordentliches) exponentielles Wachstum vor. Also sollte man mal sehen, ob man nicht mit weniger Produktionsregeln auskommt.

Einsparungen

Nun untersuchen wir im Grunde die selbe Grammatik, aber mit einer verkürzten Liste von Produktionen. In der Produktionsliste von zuvor, ist die Produktion S->E nur aus Gründen der Übersichtlichkeit enthalten. Schauen wir mal, was passiert, wenn wir diese Produktion einfach weglassen und die Produktionen der Form E->... zu S->... ändern:

arithmetikKurz={"S"-> "S+S", "S"-> "S*S", "S"-> "(S)", "S"->"x", "S"-> "y", "S"-> "z"}

Nun könnte man ja vermuten, daß die verkürzte Grammatik eine Iteration weniger braucht, um die selben Terminalstrings zu erzeugen. Nach kurzem Nachdenken darüber ist klar, daß dem nicht so ist. Die verkürzte Grammatik ist der mit einer Produktion mehr deutlich überlegen, was die Anzahl der erzeugten Terminalstrings angeht. Dies ist schnell überprüft:

resKurz=produktion[start,arithmetikKurz,5];terminalsKurz=Select[resKurz,inAlphabetQ[#,terminals]&];

res=produktion[start,arithmetik,6];terminalsLang=Select[res,inAlphabetQ[#,terminals]&];

Length /@ {terminalsLang,terminalsKurz}

D.h. die um eine Produktion verkürzte Grammatik erzeugt in fünf Iterationen 303 Terminalstrings, während die Ausgangsgrammatik nur 87 Strings erzeugt, und das mit einer Iteration mehr. Diese 87 Strings werden (natürlich) auch von der verkürzten Grammatik erzeugt:

inter=terminalsKurz⋂terminalsLang

Length @ inter

Und das sind sie auch alle:

Complement[inter, terminalsKurz]

Schauen wir uns noch an, wie schnell die Menge der prodizierten Strings wächst. Dazu wird erst wieder die Terminalstrings für fünf bis zehn Iterationen erzeugt.

resKurz = Table[Select[produktion[start,arithmetikKurz,i],inAlphabetQ[#,terminals]&],{i,5,10}];

Danach die Anzahl der Terminalstrings berechnet und entsprechend aufbereitet, daß eine graphische Darstellung gut möglich ist

produzierteTerminale = Length /@ resKurz

ergebnis = {Range[5,10],produzierteTerminale}\[Transpose];

Da die Berechnung der entsprechenden Größen recht zeitaufwendig war, werden diese in einer Excel-Tabelle abgespeichert:

Export["Terminale.xlsx",ergebnis];

Nun noch das Berechnen einer Approximation, auch hier nehmen wir wieder exponentielle Wachstum an:

approxKurz = FindFit[produzierteTerminale,a (E^(b x)),{a,b},x]

ListPlot[produzierteTerminale, PlotRange->All, PlotStyle->{Blue, PointSize[Medium]}, DataRange->{5,10}]

funcKurz[x_]:=a (E^( b x)) /. approxKurz

Plot[funcKurz[x-4],{x,5,10}, PlotRange->All, Epilog->{Blue,PointSize[Large], Point[ergebnis]}]

{b1,b2}=#[[2,2]]& /@{approx,approxKurz}

(E^({b1,b2}))

Während also die “Langversion” der Produktionen ungefäht wie (2.8^x) wächst, so kann man das Wachstum der Anzahl der von der verkürzten Grammatik erzeugten Terminalsymbole ungefähr mit (4^x) beschrieben. Ein gewaltiger Unterschied, den man auch einfach graphsich darstellen kann:

Plot[{(E^(b1 x)), (E^(b2 x))},{x,5,10}, PlotRange->All, PlotStyle->{Red, Blue}]

Kontextsensitive Grammatiken

Nun soll die (eine) Grammatik betrachtet werden die die Sprache L= {(a^n)(b^n)(c^n)|n∈ℕ} erzeugt, die bekanntlich nicht kontextfrei ist.

terminals={"a","b","c"}; rules={"S"-> "aSBC", "S"-> "aBC", "CB"->"BC", "aB"->"ab","bB"->"bb","bC"->"bc","cC"->"cc"}

Als erstes schauen wir uns mal ein paar Iterationen an:

temp = Table[produktion[{"S"}, rules,i],{i,1,4}]

Ergebnis “aufhübschen”

out = PadRight[#,Max @ (Length /@ temp)," "]& /@ temp;

Hier die Ergebnisse für eins bis vier Iterationen. Man kann hier schon erkennen, daß die “Ausbeute” an Terminalstrings nicht wirklich ergiebig ist.

TableForm[out\[Transpose],TableHeadings->{None,Range[4]}, TableAlignments->Center]

Für zehn Iterationen ergeben sich bereits insgesamt 560 produzierte Strings

res =produktion[{"S"}, rules,10];Length @ res

Die Ausbeute an Terminalstrings ist allerdingst dürftig, aber die Grammatik tut was sie soll:

Select[res,inAlphabetQ[#,terminals]&]

Als nächstes werden alle Produktionen bis zur Iterationstiefe 20 aufgesammelt:

results = Table[produktion[{"S"}, rules,i],{i,1,20}];

anzahlProduktionen = Length /@ results

Für später merken wir uns schon mal die Ausgangsdaten in entsprechender Form:

data = {Range[20],anzahlProduktionen}\[Transpose]

ListPlot[data, PlotRange->All]

tab=Table[Select[results[[i]],inAlphabetQ[#,terminals]&],{i,1,20}];

TableForm[tab, TableHeadings->{Range[20],None}]

An dieser Stelle ist anzumerken, daß mit 20 Iterationen ganze vier (!) Terminalstrings erzeugt werden, wobei insgesamt 137382 Strings erzeugt wurden. Auch hier schauen wir uns wieder das Wachstum der Anzahl der produzierten Strings an:

approx = FindFit[anzahlProduktionen,a (E^(b x)),{a,b},x]

func[x_]:=a (E^(b x))/.approx

Plot[func[x],{x,1,20},Epilog->{Red,PointSize[Medium],Point[data]}, PlotRange->All, AxesOrigin->{1,0}]

Das war ja im Grunde zu erwarten, die Anzahl der produzierten Strings wächst exponentiell, wenn auch langsamer als bei den bisher betrachteten Grammatiken:

{a,b}={a,b}/.approx; (E^b)

Das Wachstum ist also etwa wie (1.7^x). Ganz anders (natürlich) das Wachstum der Länge der produzierten Strings:

maxLengths = Table[Max @ (StringLength /@ results[[i]]),{i,1,20}]

ListPlot @ %

Hier liegt ganz offensichtlich lineares Wachstum vor. Das ist nicht so sehr überraschend, wobei man hier bei kontextsensitiven Grammatiken immer erst einmal etwas vorsichtig sein muß.

line = Fit[maxLengths,{1,x},x]

Plot[line,{x,1,20},PlotRange-> All, AxesOrigin->{0,0},Epilog->{Red, PointSize[Medium],Point [{Range[20],maxLengths}\[Transpose]]}]

Dieses präzise Ergebnis ist nicht verwunderlich. Wenn man sich die Grammatik genau ansieht, erkennt man schnell, daß eben immer drei Symbole neu erzeugt werden, die dann zu Terminalsymbolen werden und wegen S-> aSBC erhält man so die Funktion 1+3x als Wachstumsfunktion für die Terminalstrings. Alle anderen Produktionen sind sozusagen “längenneutral”.