I was bored this nightshift, so I read a bit and found this interesting post: viewtopic.php?p=589192#p589192
I've read about RPN (https://en.wikipedia.org/wiki/Reverse_Polish_notation) several times and twenty years ago I wrote a parser for terms, equation solver and graph drawer in Delphi, while I was attending school (I was the king, but the kind of king who didn't get chicks and just nerd fanboys). However, my "genius" attempt which succeeded, was to enclose the formula in brackets, then search the rightmost opening bracket and solve the term between it and the next closing one. Replace it with the result, then repeat. That was really cool and the teachers were impressed.
So now, I really dug into RPN and yeah, it's much easier...of course. Well, so now I had time and started creating a parser that dissolves the term and calculates it. The keyword is Shunting yard algorithm (https://en.wikipedia.org/wiki/Shunting_yard_algorithm).
So now I started my parser and it already can dissolve easy terms as well as work with negative numbers. There's still much to do, but tomorrow will be nightshift again.
So if anyone is interested, here's a sneak peak into my horrendous piece of code:
Code: Select all
DeclareModule Purecival
Declare Parse(term.s)
EndDeclareModule
Module Purecival
EnableExplicit
Enumeration
#PC_Error_NoError ;No error occured
#PC_Error_Bracket ;Invalid bracket configuration
#PC_Error_EmptyTerm ;Term is empty, like "()"
#PC_Error_InvalidTerm ;Term is invalid (invalid char at start or end)
EndEnumeration
Enumeration Operatorlevel
#OpL_1;&%
#OpL_2;+-
#OpL_3;*/\
#OpL_4;^
EndEnumeration
Enumeration Operator
#Op_BracketOpen
#Op_BracketClose
#Op_Plus
#Op_Minus
#Op_Times
#Op_Divide
#Op_Square
#Op_Modulo
#Op_BinaryAnd
#Op_BinaryOr
EndEnumeration
Enumeration Token
#Token_Operator
#Token_Value
EndEnumeration
#Operator = "+-*/\^&|"
#OperatorEx = "+-*/\^&|()"
#OpL_1$ = "&|"
#OpL_2$ = "+-"
#OpL_3$ = "*/\"
#OpL_4$ = "^"
Structure Op
Operator.a
OperatorLevel.a
EndStructure
Structure Token
Value.d
Type.a
EndStructure
Global LastError,NewList Tokens.Token(),NewMap OpMap.a()
OpMap("|")=#Op_BinaryOr:OpMap("&")=#Op_BinaryAnd:OpMap("*")=#Op_Times:OpMap("(")=#Op_BracketOpen:OpMap(")")=#Op_BracketClose:OpMap("-")=#Op_Minus:OpMap("\")=#Op_Modulo:opmap("/")=#Op_Divide:OpMap("+")=#Op_Plus:OpMap("^")=#Op_Square
Procedure.s TokenGenerator(term.s)
Protected NewList OpStack.Op(),counter=1,counter2,lterm=Len(term),lastoplevel.b,mterm.s,thisoplevel.b,lasttokentype.b
ClearList(Tokens())
While counter<=lterm
mterm=Mid(term,counter,1)
Select mterm
Case "("
AddElement(OpStack())
OpStack()\Operator=#Op_BracketOpen
Case ")"
While ListSize(OpStack())
LastElement(OpStack())
Select OpStack()\Operator
Case #Op_BracketOpen
DeleteElement(OpStack())
If ListSize(OpStack())
LastElement(OpStack())
lastoplevel=OpStack()\OperatorLevel
Else
lastoplevel=-1
EndIf
Break
Default
AddElement(Tokens())
Tokens()\Type=#Token_Operator
Tokens()\Value=OpStack()\Operator
DeleteElement(OpStack())
EndSelect
Wend
Default
;Zeichen ist Operator:
If FindString(#OpL_4$,mterm)
thisoplevel=#OpL_4
lasttokentype=#True
ElseIf FindString(#OpL_3$,mterm)
thisoplevel=#OpL_3
lasttokentype=#True
ElseIf FindString(#OpL_2$,mterm)
If lasttokentype
thisoplevel=-1
Else
thisoplevel=#OpL_2
lasttokentype=#True
EndIf
ElseIf FindString(#OpL_1$,mterm)
thisoplevel=#OpL_1
lasttokentype=#True
;Zeichen ist Beginn einer Zahl:
Else
thisoplevel=-1
EndIf
If thisoplevel=-1
lasttokentype=#False
counter2=counter
While counter2<=lterm
counter2=counter2+1
If FindString(#OperatorEx,Mid(term,counter2,1))
Break
EndIf
Wend
AddElement(Tokens())
Tokens()\Type=#Token_Value
Tokens()\Value=ValD(Mid(term,counter,counter2-counter))
counter=counter2-1
EndIf
If thisoplevel>-1
If thisoplevel<=lastoplevel And Not (lastoplevel=thisoplevel And lastoplevel=#OpL_4)
While LastElement(OpStack())
If OpStack()\Operator=#Op_BracketOpen
Break
ElseIf OpStack()\OperatorLevel>=thisoplevel
AddElement(Tokens())
Tokens()\Type=#Token_Operator
Tokens()\Value=OpStack()\Operator
DeleteElement(OpStack())
Else
Break
EndIf
Wend
EndIf
AddElement(OpStack())
OpStack()\Operator=OpMap(mterm)
OpStack()\OperatorLevel=thisoplevel
lastoplevel=thisoplevel
EndIf
EndSelect
counter+1
Wend
While LastElement(OpStack())
If OpStack()\Operator<>#Op_BracketOpen
AddElement(Tokens())
Tokens()\Type=#Token_Operator
Tokens()\Value=OpStack()\Operator
EndIf
DeleteElement(OpStack())
Wend
EndProcedure
Procedure Calculate()
Protected LeftOp.d,RightOp.d,*element,Op.b
If ListSize(Tokens())>2
SelectElement(Tokens(),2)
While ListSize(Tokens())>1
If Tokens()\Type=#Token_Operator
Op=Tokens()\Value
DeleteElement(Tokens())
RightOp=Tokens()\Value
DeleteElement(Tokens())
LeftOp=Tokens()\Value
Select Op
Case #Op_Plus
Tokens()\Value=LeftOp+RightOp
Case #Op_Minus
Tokens()\Value=LeftOp-RightOp
Case #Op_Times
Tokens()\Value=LeftOp*RightOp
Case #Op_Divide
Tokens()\Value=LeftOp/RightOp
Case #Op_Modulo
Tokens()\Value=Mod(LeftOp,RightOp)
Case #Op_Square
Tokens()\Value=Pow(LeftOp,RightOp)
; Case #Op_BinaryAnd
; Tokens()\Value=IntQ(LeftOp)&IntQ(RightOp)
; Case #Op_BinaryOr
; Tokens()\Value=IntQ(LeftOp)|IntQ(RightOp)
EndSelect
;Debug StrD(LeftOp)+","+StrD(RightOp)+"="+StrD(Tokens()\Value)
Else
NextElement(Tokens())
EndIf
Wend
EndIf
FirstElement(Tokens())
EndProcedure
Procedure Parse(term.s)
Protected bracket_open.w,bracket_close.w,start,ende,midterm.s,temp_var
LastError=#PC_Error_NoError
;Term aufbereiten
term=ReplaceString(term,#TAB$,"")
term=ReplaceString(term," ","")
;Klammern zählen und ausgleichen
bracket_open=CountString(term,"(")
bracket_close=CountString(term,")")
If bracket_close>bracket_open:lasterror=#PC_Error_Bracket:ProcedureReturn:EndIf
If bracket_close<bracket_open:term=LSet(term,Len(term)+bracket_open-bracket_close,")"):EndIf
TokenGenerator(term)
; ForEach Tokens()
; Debug Str(Tokens()\Type)+": "+StrD(Tokens()\Value)
; Next
Calculate()
ProcedureReturn Tokens()\Value
EndProcedure
EndModule
UseModule Purecival
;Parse("18+5*6/8*2-3")
Debug Parse("(18+36/8*2-3)*(3+2*4)+-111")
No need to point out all the flaws and what's missing, I'm on it.