Ein DFA ist ein deterministischer finiter Automat, manchmal auch deterministischer endlicher Automat genannt. Um zu erfahren, was ein Automat oder ein regulärer Ausdruck ist, empfehle ich, mal im Internet zu suchen oder bei genügend Interesse gleich die passenden Bücher zu kaufen (Reguläre Ausdrücke von O'Reilly und Compilerbau Teil 1 im Oldenbourgverlag, das "Drachenbuch").
Dieses Projekt erzeugt Zustände für einen DFA in VB. Der DFA-Code liegt dem Projekt bei, es ist die Funktion Test_DFA im Modul DFAs. Um einen eigenen DFA zu erstellen, muss man die Funktion nur kopieren und ggf. anpassen, u.a. den Pfad der Übergangstabelle.
Diese DFAs hier können im Prinzip nur sagen, ob ein übergebener String ab einer angegebenen Position einem regulären Ausdruck entspricht, also akzeptiert wird. Die Automaten geben die letzte Stelle des längsten gefundenen Musters zurück. Ein Beispiel für den Einsatz eines DFAs ist der Scanner, welcher praktischerweise mit dem Programm selber erstellt wurde.
Das Projekt besteht aus drei Teilen, dem Scanner, dem LR(1)-Parser und dem Konstruktor. Der Scanner wandelt den Eingabestring, welcher einen korrekten regulären Ausdruck beinhaltet, in einen Symbolstrom um. Der Parser konstruiert einen Syntaxbaum und der Konstruktor bildet die verschiedenen Mengen und schließlich die Zustände.
Ein Erfassen von Teilmengen mit Klammern ist auf Grund der Natur der DFAs nicht möglich (siehe "Reguläre Ausdrücke", O'Reilly). Dafür benötigt man einen NFA (Nichtdeterministischen finiten Automaten) oder einen hybriden Automaten. Wer Spaß dran hat - die Menge Followpos ist nichts anderes als ein NFA.
Der Vorteil eines DFAs ist die Geschwindigkeit. DFAs sind textorientiert, ihre Laufzeit entspricht O(n) wenn die Eingabe n Zeichen hat. Die Laufzeit von NFAs entspricht O(r*n) wenn r die Länge des regulären Ausdrucks ist. Der Nachteil eines DFAs ist der Platzbedarf im Vergleich zu einem NFA. Dieser beträgt beim DFA O(2^r) während er beim NFA nur O(r) beträgt (siehe hierzu das "Drachenbuch" s.o.).
Der vorliegende Code hat einige Einschränkungen bei den regulären Ausdrücken. Er unterstützt nicht alle Konstrukte, die man aus Sprachen wie Perl oder PHP kennt.
Ihm sind einfache Zeichenklassen \w, \d, \s, \W, \D, \S, "." und [] bekannt. Unterstütze Metazeichen sind \n für vbLf, \r für vbCr und \t für vbTab. Beliebige ASCII-Zeichen können durch \xFF angegeben werden, wobei die beiden Fs durch den hexadezimalen ASCII-Code des Zeichens zu ersetzen sind. Die Metazeichen sowie die Zeichenklassen bis auf den Punkt werden auch innerhalb von Zeichenklassen [] selber unterstützt. Ein Bindestrich kann hier einen Bereich angeben, dies funktioniert aber nur zwischen Buchstaben, Zahlen und dem Metazeichen \xFF. Z.B. repräsentiert [a-f] eine Zeichenklasse mit allen Kleinbuchstaben von a bis f. Hier werden alle ASCII-Zeichen zwischen dem ersten Zeichen und dem zweiten Zeichen eingefügt! Der Backslash dient als Escapezeichen, muss daher auch selbst escaped werden. Durch ein Dach ^ als erstes Zeichen wird die Zeichenklasse invertiert.
Die Metaoperationen *, + und ? sind verfügbar, alle jedoch gierig. Da DFAs erstellt werden, welche textgesteuert sind, sind nicht-gierige Ausdrücke nicht ohne weiteres möglich. Dies den DFAs beizubringen ist meist unsauber - ein NFA könnte das von Haus aus.
Der Backslash kann die besondere Bedeutung beliebiger Zeichen innerhalb und ausserhalb von Zeichenklassen aufheben. Ausdrücke können beliebig durch Klammern verschachtelt werden. Die Alternation mit "|" wird unterstützt.
Bei fehlerhaften regulären Ausdrücken als Eingabe kann es vorkommen, dass kein Fehler gemeldet wird oder der Automat sich seltsam verhält. Sollten Fehler entdeckt werden, bitte ich darum, mir eine Email zu schicken.
History
05.10.2003 Hinzugefügt
Autor: Dominik Auras <Dominik_auf_vbInside.de>
Code aus Konstruktor.bas
Option ExplicitPublic Type Menge
Element() As Long
End Type
Public Type Zustand
pos As Menge
acc As Boolean
tran() As Long
End Type
Private cp As Long, pos_ptr() As Long, follow() As Menge
Private Stream() As Symbol, sym_stack() As String
Private eingabezeichen() As Long, ce As Long, match() As Menge
Private zustaende() As Zustand, rootsym As Long
Public classes() As Menge
Public Sub BildeMengen(ByRef x() As Symbol, root As Long, _
endsymptr As Long, positions() As Long, followpos() As Menge, _
Eingabe() As Long, matches() As Menge, x_zustaende() As Zustand)
ReDim pos_ptr(100)
ReDim follow(100)
ReDim eingabezeichen(100)
ReDim sym_stack(0)
cp = 0: ce = 0: rootsym = root
Stream = x
Phase1 root
If cp > 0 Then
ReDim Preserve pos_ptr(cp - 1)
ReDim Preserve follow(cp - 1)
Else
ReDim pos_ptr(0)
ReDim follow(0)
pos_ptr(0) = -1
End If
If ce > 0 Then
ReDim Preserve eingabezeichen(ce - 1)
Else
ReDim eingabezeichen(0)
eingabezeichen(0) = -1
End If
Phase2
BerechneZustaende endsymptr
positions = pos_ptr
followpos = follow
Eingabe = eingabezeichen
matches = match
x_zustaende = zustaende
x = Stream
End Sub
Private Sub BerechneZustaende(endsymptr As Long)
Dim i As Long, n As Long, c As Long, f As Menge, g As Long
Dim s_menge As Menge, h As Long, Ende As Long, attr As Sym_Attr
ReDim zustaende(1 To 1)
If Not FindAttr(Stream(endsymptr), pos, attr) Then
warn "Keine Endposition vorhanden"
End If
Ende = attr.val
ReDim zustaende(1).pos.Element(UBound(Stream(rootsym).First))
For i = 0 To UBound(Stream(rootsym).First)
zustaende(1).pos.Element(i) = Stream(rootsym).First(i)
Next i
ReDim zustaende(1).tran(255)
i = 1
Do
For c = 0 To 255
If Not Schnittmenge_Leer(zustaende(i).pos, match(c)) Then
s_menge = Schnittmenge(zustaende(i).pos, match(c))
f = followpos(s_menge)
Init_IfNecessary f.Element
n = Menge_In_Zustaende(f)
If n > 0 Then
zustaende(i).tran(c) = n
Else
ReDim Preserve zustaende(1 To UBound(zustaende) + 1)
zustaende(UBound(zustaende)).pos = f
ReDim zustaende(UBound(zustaende)).tran(255)
zustaende(i).tran(c) = UBound(zustaende)
If Element_In_Menge(f, Ende) Then
zustaende(UBound(zustaende)).acc = True
End If
End If
End If
Next c
i = i + 1
If i > UBound(zustaende) Then
Exit Do
End If
Loop
End Sub
Private Sub Phase2()
Dim i As Long, n As Long, sym As Symbol, mat As Boolean
Dim attr As Sym_Attr
If eingabezeichen(0) = -1 Then
Exit Sub
End If
ReDim match(255)
For i = 0 To 255
Init_IfNecessary match(i).Element
For n = 0 To UBound(pos_ptr)
sym = Stream(pos_ptr(n))
mat = False
If sym.id = Char Then
mat = sym.lexeme = Chr$(i)
ElseIf sym.id = Meta Then
If FindAttr(sym, Klasse, attr) Then
If Element_In_Class(Chr$(i), attr.val) Then
mat = True
End If
Else
Debug.Print "Fehler in Phase 2"
End If
End If
FindAttr sym, pos, attr
If mat Then
AddElement match(i), attr.val
End If
Next n
Next i
End Sub
Private Function Phase1(root As Long) As Boolean
Dim i As Long, b_nullable() As Boolean, n As Long
Dim child0 As Symbol, child1 As Symbol
On Error Resume Next
i = Stream(root).Child(0)
If Err.Number <> 0 Then
Err.Clear
ReDim Stream(root).Child(0)
Stream(root).Child(0) = -1
End If
If UBound(Stream(root).Child) = 0 And Stream(root).Child(0) = _
-1 Then
SetAttr Stream(root), pos, cp
pos_ptr(cp) = root
SetAttr Stream(root), nullable, -1
Phase1 = False
ReDim Stream(root).First(0)
Stream(root).First(0) = cp
ReDim Stream(root).Last(0)
Stream(root).Last(0) = cp
If Not OnStack_String(sym_stack, Stream(root).lexeme) Then
push_s sym_stack, Stream(root).lexeme
eingabezeichen(ce) = root
ce = ce + 1
If ce > UBound(eingabezeichen) Then
ReDim Preserve eingabezeichen(UBound(eingabezeichen) * 2)
End If
End If
cp = cp + 1
If cp > UBound(pos_ptr) Then
ReDim Preserve pos_ptr(UBound(pos_ptr) * 2)
End If
End If
ReDim b_nullable(UBound(Stream(root).Child))
For i = 0 To UBound(Stream(root).Child)
b_nullable(i) = True
If Stream(root).Child(i) >= 0 Then
b_nullable(i) = Phase1(Stream(root).Child(i))
End If
Next i
child0 = Stream(Stream(root).Child(0))
child1 = Stream(Stream(root).Child(1))
Select Case Stream(root).id
Case Sym_ID.Meta_Or
Phase1 = b_nullable(0) Or b_nullable(1)
SetAttr Stream(root), nullable, IIf(Phase1, 1, -1)
Join_Arr child0.First, child1.First, Stream(root).First
Join_Arr child0.Last, child1.Last, Stream(root).Last
Case Sym_ID.MetaOp
If Stream(root).lexeme = "+" Then
Phase1 = False
Else
Phase1 = True
End If
SetAttr Stream(root), nullable, IIf(Phase1, 1, -1)
Stream(root).First = child0.First
Stream(root).Last = child0.Last
If Stream(root).lexeme = "+" Or Stream(root).lexeme = "*" Then
For i = 0 To UBound(child0.Last)
If child0.Last(i) >= 0 Then
For n = 0 To UBound(child0.First)
If child0.First(n) >= 0 Then
AddElement follow(child0.Last(i)), child0.First(n)
End If
Next n
End If
Next i
End If
Case Sym_ID.Cat
Phase1 = b_nullable(0) And b_nullable(1)
SetAttr Stream(root), nullable, IIf(Phase1, 1, -1)
If b_nullable(0) Then
Join_Arr child0.First, child1.First, Stream(root).First
Else
Stream(root).First = child0.First
End If
If b_nullable(1) Then
Join_Arr child0.Last, child1.Last, Stream(root).Last
Else
Stream(root).Last = child1.Last
End If
For i = 0 To UBound(child0.Last)
If child0.Last(i) >= 0 Then
For n = 0 To UBound(child1.First)
If child1.First(n) >= 0 Then
AddElement follow(child0.Last(i)), child1.First(n)
End If
Next n
End If
Next i
End Select
End Function
Private Sub Join_Arr(src1() As Long, src2() As Long, dest() As Long)
Dim i As Long
ReDim dest(UBound(src1) + UBound(src2) + 1)
For i = 0 To UBound(src1)
dest(i) = src1(i)
Next i
For i = 0 To UBound(src2)
dest(UBound(src1) + 1 + i) = src2(i)
Next i
End Sub
Public Sub AddElement(Menge As Menge, x As Long)
Dim i As Long
On Error Resume Next
i = Menge.Element(0)
If Err.Number <> 0 Then
Err.Clear
ReDim Menge.Element(0)
Menge.Element(0) = -1
End If
For i = 0 To UBound(Menge.Element)
If Menge.Element(i) = x Then
Exit Sub
End If
Next i
If Not (UBound(Menge.Element) = 0 And Menge.Element(0) = -1) Then
ReDim Preserve Menge.Element(UBound(Menge.Element) + 1)
End If
Menge.Element(UBound(Menge.Element)) = x
End Sub
Public Function CatElemente(x As Menge) As String
Dim i As Long
On Error Resume Next
i = x.Element(0)
If Err.Number <> 0 Then
Err.Clear
CatElemente = ""
Exit Function
End If
CatElemente = ""
For i = 0 To UBound(x.Element)
If Not x.Element(i) = -1 Then
CatElemente = CatElemente & CStr(x.Element(i)) & ", "
End If
Next i
CatElemente = Left$(CatElemente, Len(CatElemente) - 2)
End Function
Private Function Element_In_Class(a As String, class As Long) As Boolean
Dim i As Long, aa As Long
aa = Asc(a)
For i = 0 To UBound(classes(class).Element)
If classes(class).Element(i) = aa Then
Element_In_Class = True
Exit Function
End If
Next i
End Function
Public Sub init_classes(class() As Menge)
Dim i As Long, n As String
For i = Asc("a") To Asc("z")
AddElement class(1), i
Next i
For i = Asc("A") To Asc("Z")
AddElement class(1), i
Next i
n = "äöüÄÖÜß"
For i = 1 To Len(n)
AddElement class(1), Asc(Mid$(n, i, 1))
Next i
For i = Asc("0") To Asc("9")
AddElement class(2), i
Next i
For i = 0 To Asc(vbLf) - 1
AddElement class(3), i
Next i
For i = Asc(vbLf) + 1 To 255
AddElement class(3), i
Next i
n = "abcdefghijklmnopqrstuvwxyzäöüßÄÖÜABCDEFGHIJKLMNOPQRSTUVWXYZ"
For i = 0 To 255
If InStr(n, Chr$(i)) = 0 Then
AddElement class(4), i
End If
Next i
For i = 0 To Asc("0") - 1
AddElement class(5), i
Next i
For i = Asc("9") + 1 To 255
AddElement class(5), i
Next i
AddElement class(6), Asc(" ")
AddElement class(6), Asc(vbTab)
AddElement class(6), Asc(vbLf)
n = " " & vbTab & vbLf
For i = 0 To 255
If InStr(n, Chr$(i)) = 0 Then
AddElement class(7), i
End If
Next i
End Sub
Private Function Schnittmenge_Leer(m1 As Menge, m2 As Menge) As Boolean
Dim i As Long, n As Long
For i = 0 To UBound(m1.Element)
For n = 0 To UBound(m2.Element)
If m1.Element(i) = m2.Element(n) Then
Schnittmenge_Leer = False
Exit Function
End If
Next n
Next i
Schnittmenge_Leer = True
End Function
Private Function Schnittmenge(m1 As Menge, m2 As Menge) As Menge
Dim i As Long, n As Long
For i = 0 To UBound(m1.Element)
For n = 0 To UBound(m2.Element)
If m1.Element(i) = m2.Element(n) Then
AddElement Schnittmenge, m1.Element(i)
End If
Next n
Next i
Init_IfNecessary Schnittmenge.Element
For i = UBound(Schnittmenge.Element) To 0 Step -1
For n = 0 To i - 1
If Schnittmenge.Element(n) > Schnittmenge.Element(i) Then
Schnittmenge.Element(n) = Schnittmenge.Element(n) Xor _
Schnittmenge.Element(i)
Schnittmenge.Element(i) = Schnittmenge.Element(n) Xor _
Schnittmenge.Element(i)
Schnittmenge.Element(n) = Schnittmenge.Element(n) Xor _
Schnittmenge.Element(i)
End If
Next n
Next i
End Function
Private Function Menge_In_Zustaende(m As Menge) As Long
Dim i As Long, n As Long, mat As Boolean
For i = 1 To UBound(zustaende)
If UBound(zustaende(i).pos.Element) = UBound(m.Element) Then
For n = 0 To UBound(zustaende(i).pos.Element)
mat = zustaende(i).pos.Element(n) = m.Element(n)
If Not mat Then
Exit For
End If
Next n
If mat Then
Menge_In_Zustaende = i: Exit Function
End If
End If
Next i
Menge_In_Zustaende = -1
End Function
Private Function followpos(m As Menge) As Menge
Dim i As Long, f As Menge, n As Long
For i = 0 To UBound(m.Element)
If Not m.Element(i) = -1 Then
f = follow(m.Element(i))
Init_IfNecessary f.Element
For n = 0 To UBound(f.Element)
If Not f.Element(n) = -1 Then
AddElement followpos, f.Element(n)
End If
Next n
End If
Next i
Init_IfNecessary followpos.Element
For i = UBound(followpos.Element) To 0 Step -1
For n = 0 To i - 1
If followpos.Element(n) > followpos.Element(i) Then
followpos.Element(n) = followpos.Element(n) Xor _
followpos.Element(i)
followpos.Element(i) = followpos.Element(n) Xor _
followpos.Element(i)
followpos.Element(n) = followpos.Element(n) Xor _
followpos.Element(i)
End If
Next n
Next i
End Function
Private Sub Init_IfNecessary(arr() As Long)
Dim i As Long
On Error Resume Next
i = arr(0)
If Err.Number <> 0 Then
Err.Clear
ReDim arr(0)
arr(0) = -1
End If
End Sub
Private Function Menge_Leer(m As Menge) As Boolean
Dim i As Long
On Error Resume Next
i = m.Element(0)
If Err.Number <> 0 Then
Err.Clear
Menge_Leer = True
Exit Function
End If
If UBound(m.Element) = 0 And m.Element(0) = -1 Then
Menge_Leer = True
Exit Function
End If
Menge_Leer = False
End Function
Public Function Element_In_Menge(m1 As Menge, e As Long) As Boolean
Dim i As Long, n As Long
If e = -1 Then
Exit Function
End If
Init_IfNecessary m1.Element
For i = 0 To UBound(m1.Element)
If m1.Element(i) = e Then
Element_In_Menge = True
Exit Function
End If
Next i
Element_In_Menge = False
End Function
Public Sub warn(x As String)
Debug.Print x
End Sub
