Rekursiv absteigender Parser
Verfasst: 27.07.2008 15:43
xxx
Code: Alles auswählen
Procedure.s MyStr(v.d)
Protected exp=CreateRegularExpression(#PB_Any, "(|\.)0*$")
Protected ret.s=ReplaceRegularExpression(exp, StrD(v), "")
FreeRegularExpression(exp)
ProcedureReturn ret
EndProcedure
Debug mystr(4.20)
Die zweite Version habe ich auch extra für Dich geschrieben.AND51 hat geschrieben:Ohhhh, welch schöner Code!
Mich jucks buchstäblich in den Fingern...
Ich bin ehrlich gespannt, denn ich stelle es mir gar nicht so einfach vor, diverse mathematische Ausdrücke mit RegEx in Token aufzuteilen.AND51 hat geschrieben:Demnächst mach ich mich noch mal genauer hier dran,
Das könnte man tatsächlich mit einer gewissen Berechtigung annehmen. Der Witz ist, dass man mit der gleichen Berechtigung sagen kann: 0 hoch irgendwas ist immer null, also ist 0^0=0. Der Widerspruch, ob 0^0 nun den Wert 1 oder den Wert 0 hat, lässt sich nicht auflösen, daher ist 0^0 undefiniert [Quelle: MathWorld].AND51 hat geschrieben:Irgendwas hoch null ist immer 1, das gilt auch für 0^0=1.
Jo, das is schon klar. Ich habe allerdings die Regel "Zwei Rechenzeichen dürfen nicht nebeneinander stehen." eingebaut, d.h. man muss das mit Klammern schreiben:AND51 hat geschrieben:Wenn der Exponent negativ ist, dann ist eine Rechnung weiterhin möglich. Beispiel:
5^-1=1/5=0.2
Code: Alles auswählen
5^(-1)
Na ja, ich will's erst noch werden.AND51 hat geschrieben:Da du genau wie ich ein RegExp-Fan bist,
Dafür gibt es Grammatiken, die sogar ein unäres und ein binäres MinusAND51 hat geschrieben:Ich weiß bloß beim besten Willen noch nicht, wie ich so vorrausschauend rechnen soll, sodass ich Punkt-vor-Strich-Rechnung etc. hinbekomme...
Alles andere ist jedoch schon... gut geplant.
AND51 hat geschrieben:Ich weiß bloß beim besten Willen noch nicht, wie ich so vorrausschauend rechnen soll, sodass ich Punkt-vor-Strich-Rechnung etc. hinbekomme...
Code: Alles auswählen
TokenArray(0)\Str = "1"
TokenArray(1)\Str = "+"
TokenArray(2)\Str = "2"
TokenArray(3)\Str = "*"
TokenArray(4)\Str = "3"
... und vor allem wird der Sonderfall "0 hoch 0" relativ ausführlich besprochen. Danke für diesen Hinweis. Ich werde mir das in Ruhe überlegen, und dann ggf. im Code ändern.AND51 hat geschrieben:Also noch mal Wikipediarangezogen und tatsächlich gibt es einen Gewinner: Die Einser-Partei.
"Die Hochzahl 0 sagt aus, dass die Zahl 1 keinmal mit der Grundzahl multipliziert wird und alleine stehen bleibt, so dass man das Ergebnis 1 erhält."
Der dritte Punkt -- die Definition der Muster (1 Zeile, durch ## gekennzeichnet) -- ist so schon ganz gut, alle von mir getesteten gültigen Ausdrücke wurden richtig erkannt. Aber vor allem die Erkennung von Syntaxfehlern kann noch verbessert werden. Ich kenne mich mit Regulären Ausdrücken nicht sooo gut aus.- Prozedur NextToken() gelöscht
- Prozedur Scan() umgeschrieben
- Am Programmanfang Definition von Mustern für gültige Token
Code: Alles auswählen
; Rekursiv absteigender Parser.
; Calc() ist die einzige aufrufbare Routine, ihr muss ein String
; übergeben werden, der einen mathematischen Ausdruck enthält.
; Es wird wieder ein String zurückgeliefert. Dieser ist entweder
; das Ergebnis (erstes Zeichen ist eine Ziffer) oder eine Fehler-
; meldung (erstes Zeichen ist keine Ziffer).
; -- getestet mit PureBasic 4.20, 30.7.2008
; -- angepasst für PureBasic 4.30, 12.1.2009
; -- Little John
; Anmerkung:
; 0^0 ergibt hier 1, wie bei PB und vielen anderen Programmiersprachen.
; In der Mathematik gibt es darüber eine alte Diskussion, siehe z.B.:
; <http://de.wikipedia.org/wiki/Potenzen>
; <http://en.wikipedia.org/wiki/Exponentiation#Zero_to_the_zero_power>
; <http://mathforum.org/dr.math/faq/faq.0.to.0.power.html>
; <http://mathworld.wolfram.com/Zero.html>
EnableExplicit
;-- Token types
Enumeration
#Unknown
#Operator
#DecNumber
#HexNumber
#Identifier
EndEnumeration
;-- Token definitions
#OpRel = "<=<>="
#OpChars = #OpRel + "+-*/^),"
#Letters = "abcdefghijklmnopqrstuvwxyz"
#DecDigits = "0123456789"
#HexDigits = #DecDigits + "abcdef"
#AlphaNum = #Letters + #DecDigits
;-- Constants
#E = 2.7182818284590452
;-- Error messages
#Err_BadSyntax = "Syntaxfehler"
#Err_MissingOperator = "Operator fehlt"
#Err_NoClosingBracket = ") fehlt"
#Err_NoOpeningBracket = "( fehlt"
#Err_UnknownOperator = "Unbekannter Operator: "
#Err_UnknownFunction = "Unbekannte Funktion: "
#Err_UnknownConstant = "Unbekannte Konstante: "
#Err_InvalidDecNumber = "Ungültige Dezimalzahl"
#Err_InvalidHexNumber = "Ungültige Hexadezimalzahl"
#Err_ParameterMismatch = "(): Falsche Parameteranzahl"
#Err_NegativeBase = "Negative Basis mit gebrochenem Exponenten"
#Err_DivisionByZero = "Division durch Null"
#Err_Sqr = "Quadratwurzel aus negativer Zahl"
#Err_Log = "Logarithmus aus Zahl <= 0"
#Err_LogBase = "Logarithmus zu Basis <= 0 oder 1"
Structure Tokens
Str.s
Typ.i
EndStructure
Global Dim TokenArray.Tokens(0)
Global Token.s, Error.s
Global TokenType, Rex
; ## Muster für gültige Token definieren ##
; (z.B. Erkennung ungültiger Zeichen kann noch verbessert werden)
Rex = CreateRegularExpression(#PB_Any, "\d+|\$[\da-f]*|[<>=!]+|[a-z]+|[-+\*/^().,]")
If Rex = 0
Debug "Fehler beim Erzeugen des Regulären Ausdrucks: " + RegularExpressionError()
End
EndIf
;-----------------------------------------------------------------------
Procedure Scan (expr.s)
;-- kompletten Ausdruck vorab in die einzelnen Token aufteilen,
; und diese in TokenArray() speichern.
Dim result.s(0)
Protected firstChar.s
Protected n, k
n = ExtractRegularExpression(Rex, expr, result())
Dim TokenArray.Tokens(n+1)
For k = 0 To n-1
TokenArray(k)\Str = result(k)
firstChar = Left(result(k), 1)
If FindString(#OpChars, firstChar, 1)
TokenArray(k)\Typ = #Operator
ElseIf FindString(#Letters, firstChar, 1)
TokenArray(k)\Typ = #Identifier
ElseIf FindString(#DecDigits, firstChar, 1)
TokenArray(k)\Typ = #DecNumber
ElseIf firstChar = "$"
TokenArray(k)\Typ = #HexNumber
Else
TokenArray(k)\Typ = #Unknown
EndIf
Next
EndProcedure
Procedure GetToken (idx=-1)
;-- holt immer den nächsten Token aus TokenArray()
Static index
If idx <> -1 ; nur beim ersten Aufruf
index = idx
EndIf
Token = TokenArray(index)\Str
TokenType = TokenArray(index)\Typ
index + 1
EndProcedure
;-----------------------------------------------------------------------
;-- selbst definierte Funktionen
Procedure.d Min (List Args.d())
; in : verknüpfte Liste aus beliebig vielen reellen Zahlen
; out: kleinste Zahl in der Liste
Protected ret.d
ret = Args()
While NextElement(Args())
If ret > Args()
ret = Args()
EndIf
Wend
ProcedureReturn ret
EndProcedure
Procedure.d Max (List Args.d())
; in : verknüpfte Liste aus beliebig vielen reellen Zahlen
; out: größte Zahl in der Liste
Protected ret.d
ret = Args()
While NextElement(Args())
If ret < Args()
ret = Args()
EndIf
Wend
ProcedureReturn ret
EndProcedure
Procedure.d Sum (List Args.d())
; in : verknüpfte Liste aus beliebig vielen reellen Zahlen
; out: Summe aller Zahlen in der Liste
Protected ret.d
ret = Args()
While NextElement(Args())
ret + Args()
Wend
ProcedureReturn ret
EndProcedure
;-----------------------------------------------------------------------
Procedure.d Func (name.s, List Args.d())
; Hier werden alle Funktionen aufgerufen (egal ob sie in PureBasic
; eingebaut oder selbst definiert sind).
; Eine leere Argumentliste erzeugt sowieso einen Syntaxfehler,
; daher braucht das hier nicht überprüft zu werden.
Protected v.d
SelectElement(Args(), 0)
Select name
Case "sqr"
If ListSize(Args()) > 1
Error = name + #Err_ParameterMismatch
ElseIf Args() < 0
Error = #Err_Sqr
Else
v = Sqr(Args())
EndIf
Case "log"
If ListSize(Args()) > 2
Error = name + #Err_ParameterMismatch
ElseIf Args() <= 0
Error = #Err_Log
Else
v = Log(Args()) ; Die Standard-Basis ist e.
If ListSize(Args()) = 2 ; Wenn eine andere Basis angegeben ist.
NextElement(Args())
If Args() <= 0 Or Args() = 1
Error = #Err_LogBase
Else
v / Log(Args())
EndIf
EndIf
EndIf
Case "min"
v = Min(Args())
Case "max"
v = Max(Args())
Case "sum"
v = Sum(Args())
Default
Error = #Err_UnknownFunction + name
EndSelect
ProcedureReturn v
EndProcedure
Procedure.d Const (name.s)
Protected v.d
Select name
Case "pi"
v = #PI
Case "e"
v = #E
Default
Error = #Err_UnknownConstant + name
EndSelect
ProcedureReturn v
EndProcedure
Procedure.d Arith (op.s, v.d, r.d)
Protected ret.d = #False
If Error <> ""
ProcedureReturn ret
EndIf
Select op
Case "<"
If v < r
ret = #True
EndIf
Case ">"
If v > r
ret = #True
EndIf
Case "="
If v = r
ret = #True
EndIf
Case "<>"
If v <> r
ret = #True
EndIf
Case "<="
If v <= r
ret = #True
EndIf
Case ">="
If v >= r
ret = #True
EndIf
Case "+"
ret = v + r
Case "-"
ret = v - r
Case "*"
ret = v * r
Case "/"
If r = 0
Error = #Err_DivisionByZero
Else
ret = v / r
EndIf
Case "^"
If v < 0 And r <> Int(r)
Error = #Err_NegativeBase
ElseIf v = 0 And r < 0
Error = #Err_DivisionByZero
Else
ret = Pow(v, r)
EndIf
Default
Error = #Err_UnknownOperator + op
EndSelect
ProcedureReturn ret
EndProcedure
;-----------------------------------------------------------------------
;-- rekursive Prozeduren
Declare.d Expression()
Procedure.d Factor()
Protected op.s
Protected v.d
If TokenType = #DecNumber
op = Token
GetToken()
If Token <> "."
v = Val(op)
Else
GetToken()
If TokenType = #DecNumber
v = ValD(op + "." + Token)
Else
Error = #Err_InvalidDecNumber
EndIf
GetToken()
EndIf
ElseIf TokenType = #HexNumber
If Len(Token) > 1
v = Val(Token)
Else
Error = #Err_InvalidHexNumber
EndIf
GetToken()
ElseIf TokenType = #Identifier
op = Token
GetToken()
If Token = "("
;-- Liste der Funktionsargumente lesen
NewList Args.d()
Repeat
GetToken()
AddElement(Args())
Args() = Expression()
Until Token <> ","
If Token <> ")" And Error = ""
Error = #Err_NoClosingBracket
EndIf
GetToken()
v = Func(op, Args())
Else
v = Const(op)
EndIf
ElseIf Token = "("
GetToken()
v = Expression()
If Token <> ")" And Error = ""
Error = #Err_NoClosingBracket
EndIf
GetToken()
Else
Error = #Err_BadSyntax
EndIf
If Token <> "" And FindString(#OpChars, Token, 1) = 0 And Error = ""
If TokenType = #DecNumber Or TokenType = #HexNumber Or TokenType = #Identifier Or Token = "("
Error = #Err_MissingOperator
Else
Error = #Err_UnknownOperator + Token
EndIf
EndIf
ProcedureReturn v
EndProcedure
Procedure.d Power()
Protected v.d, r.d
v = Factor()
If Token = "^"
GetToken()
r = Power()
v = Arith("^", v, r)
EndIf
ProcedureReturn v
EndProcedure
Procedure.d Term()
Protected op.s
Protected v.d, r.d
v = Power()
op = Token
While op = "*" Or op = "/"
GetToken()
r = Power()
v = Arith(op, v, r)
op = Token
Wend
ProcedureReturn v
EndProcedure
Procedure.d Sign()
Protected op.s
Protected v.d
op = ""
If Token = "+" Or Token = "-"
op = Token
GetToken()
EndIf
v = Term()
If op = "-"
v = -v
EndIf
ProcedureReturn v
EndProcedure
Procedure.d SingleExpression()
Protected op.s
Protected v.d, r.d
v = Sign()
op = Token
While op = "+" Or op = "-"
GetToken()
r = Term()
v = Arith(op, v, r)
op = Token
Wend
ProcedureReturn v
EndProcedure
Procedure.d Expression()
Protected op.s
Protected v.d, r.d
v = SingleExpression()
op = Token
While FindString(#OpRel, op, 1) <> 0
GetToken()
r = SingleExpression()
v = Arith(op, v, r)
op = Token
Wend
ProcedureReturn v
EndProcedure
;-----------------------------------------------------------------------
Procedure.s MyStr (v.d)
;-- Hilfsroutine, die das Ergebnis von StrD() ohne überflüssige
; Nullen nach dem Dezimaltrennzeichen liefert
Protected ret.s
Protected p
ret = StrD(v)
p = Len(ret)
While Mid(ret, p, 1) = "0"
p - 1
Wend
If Mid(ret, p, 1) = "."
p - 1
EndIf
ProcedureReturn Left(ret, p)
EndProcedure
Procedure.s Calc (expr.s)
; * Hauptfunktion *
; in : zu berechnender Ausdruck als String
; out: Ergebnis als String (1. Zeichen ist eine Ziffer)
; oder
; Fehlermeldung (1. Zeichen ist ein Buchstabe)
Protected v.d
Scan(LCase(expr))
GetToken(0)
Error = ""
v = Expression()
If Error <> ""
ProcedureReturn Error
ElseIf Token = ")"
ProcedureReturn #Err_NoOpeningBracket
ElseIf Token = ","
ProcedureReturn #Err_BadSyntax
Else ; kein Fehler
ProcedureReturn MyStr(v) ; Ergebnis zurückgeben
EndIf
EndProcedure