RPN Parser

For everything that's not in any way related to PureBasic. General chat etc...
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

RPN Parser

Post by jacdelad »

Hi #PB_All,
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. :D
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")
...which is neat, because basically we need less than 150 lines of code for basic arithmetic operations.

No need to point out all the flaws and what's missing, I'm on it. :mrgreen:
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: RPN Parser

Post by STARGÅTE »

Dear jacdelad,

here some errors:

Code: Select all

Debug Parse("-2") ; gives 2
Debug Parse("1.0/2.0") ; gives 0
Debug Parse("-4^2") ; gives error
Debug Parse("(-4)^2") ; gives error
Debug Parse("(-6)*(-2)") ; gives error
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

Yeah, like I said: I just started. Negative numbers are not fully and numbers with fractions not implemented at all...
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

The obvious errors, pointed out by STARGATE, corrected:

Code: Select all

DeclareModule Purecival
  Declare.d 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,subcounter=1
    ClearList(Tokens())
    While counter<=lterm
      mterm=Mid(term,counter,1)
      Select mterm
        Case "("
          AddElement(OpStack())
          OpStack()\Operator=#Op_BracketOpen
          subcounter=0
        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 Or subcounter=1
              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:subcounter+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.d 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")

Debug Parse("-2") ; gives 2
Debug Parse("1.0/2.0") ; gives 0
Debug Parse("-4^2") ; gives error
Debug Parse("(-4)^2") ; gives error
Debug Parse("(-6)*(-2)") ; gives error
Now to scientific notation, functions, boundaries, errors...
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

Correct usage of numbers and brackets, some functions added.

Code: Select all

DeclareModule Purecival
  Declare.d Parse(Term.s,Iterations.q=1)
  Declare.s GetTokens(Term.s)
  Declare GetLastParserError()
  Declare GetLastParserTime()
EndDeclareModule

Module Purecival
  EnableExplicit
  Enumeration Error
    #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), operator at invalid position
    #PC_Error_InvalidFunction          ;Function is invalid
    #PC_Error_InvalidNumberOfArguments ;Invalid number of function arguments
  EndEnumeration
  
  Enumeration Operatorlevel 0
    #OpL_0;Funktionen
    #OpL_1;&%
    #OpL_2;+-
    #OpL_3;*/\
    #OpL_4;^
  EndEnumeration
  Enumeration Operator 1
    #Op_Plus
    #Op_Minus
    #Op_Times
    #Op_Divide
    #Op_Modulo
    #Op_Square
    #Op_BinaryAnd
    #Op_BinaryOr
    #Op_BracketOpen
    #Op_BracketClose
  EndEnumeration
  Enumeration Function 1
    #Function_Abs
    #Function_ACos
    #Function_ACosH
    #Function_ASin
    #Function_ASinH
    #Function_ATan
    #Function_ATanH
    #Function_Cos
    #Function_CosH
    #Function_Deg
    #Function_Exp
    #Function_Frac
    #Function_Int
    #Function_LogTen
    #Function_LogTwo
    #Function_Neg
    #Function_Rad
    #Function_Sin
    #Function_SinH
    #Function_Sqr
    #Function_Sqrt
    #Function_Tan
    #Function_TanH
  EndEnumeration
  Enumeration Token
    #Token_Operator
    #Token_Value
    #Token_Function_1
    #Token_Function_2
  EndEnumeration
  
  #Operator   = "+-*/\^&|"
  #OperatorEx = "+-*/\^&|(),"
  #OpL_1$ = "&|"
  #OpL_2$ = "+-"
  #OpL_3$ = "*/\"
  #OpL_4$ = "^"
  #FunctionList = "Cos|Sin"
  
  Structure Op
    OperatorLevel.a
    StructureUnion
      Operator.a
      Function.i
    EndStructureUnion
  EndStructure
  Structure Token
    Type.a
    StructureUnion
      Value.d
      Function.i
    EndStructureUnion
  EndStructure
  
  Global LastError.a,LastTime.q,NewList Tokens.Token(),NewMap FunctionMap.w()
  FunctionMap("ABS")=#Function_Abs
  FunctionMap("ACOS")=#Function_ACos
  FunctionMap("ACOSH")=#Function_ACosH
  FunctionMap("ASIN")=#Function_ASin
  FunctionMap("ASINH")=#Function_ASinH
  FunctionMap("ATAN")=#Function_ATan
  FunctionMap("ATANH")=#Function_ATanH
  FunctionMap("COS")=#Function_Cos
  FunctionMap("COSH")=#Function_CosH
  FunctionMap("DEG")=#Function_Deg
  FunctionMap("EXP")=#Function_Deg
  FunctionMap("FRAC")=#Function_Frac
  FunctionMap("INT")=#Function_Int
  FunctionMap("LOGTWO")=#Function_LogTwo
  FunctionMap("LOGTEN")=#Function_LogTen
  FunctionMap("NEG")=#Function_Neg
  FunctionMap("RAD")=#Function_Rad
  FunctionMap("SIN")=#Function_Sin
  FunctionMap("SINH")=#Function_SinH
  FunctionMap("SQR")=#Function_Sqr
  FunctionMap("SQRT")=#Function_Sqrt
  FunctionMap("TAN")=#Function_Tan
  FunctionMap("TANH")=#Function_TanH
  
  CreateRegularExpression(0,"^[\+\-]??\d*\.??\d+(?:[Ee][\+\-]?\d+)?$")
  
  Macro LastTime()
    LastTime=ElapsedMilliseconds()-LastTime
  EndMacro
  Macro PreprocessTerm()
    Protected bracket_open.w,bracket_close.w,temp_term.s,temp_counter.w
    LastError=#PC_Error_NoError
    
    ;Term aufbereiten
    term=ReplaceString(term,#TAB$,"")
    term=ReplaceString(term," ","")
    term=UCase(term)
    
    ;Klammern zählen und ausgleichen
    bracket_open=CountString(term,"(")
    bracket_close=CountString(term,")")
    If bracket_close>bracket_open:lasterror=#PC_Error_Bracket:LastTime():ProcedureReturn:EndIf
    If bracket_close<bracket_open:term=LSet(term,Len(term)+bracket_open-bracket_close,")"):EndIf
    term=ReplaceString(term,")(",")*(")
    
    ;Leere Terme filtern
    temp_term=ReplaceString(term,".","")
    temp_term=ReplaceString(temp_term,",","")
    For temp_counter=1 To Len(#OperatorEx)
      temp_term=ReplaceString(temp_term,Mid(#OperatorEx,temp_counter,1),"")
    Next
    If Len(temp_term)=0:lasterror=#PC_Error_EmptyTerm:LastTime():ProcedureReturn:EndIf
  EndMacro
  Procedure TokenGenerator(Term.s)
    Protected NewList OpStack.Op(),counter=1,counter2,lterm=Len(term),lastoplevel.b,mterm.s,thisoplevel.b,lasttokentype.b,subcounter=1,function.i
    ClearList(Tokens())
    While counter<=lterm
      mterm=Mid(term,counter,1)
      Select mterm
        Case "("
          AddElement(OpStack())
          OpStack()\Operator=#Op_BracketOpen
          OpStack()\OperatorLevel=#OpL_1
          thisoplevel=#OpL_1
          lastoplevel=#OpL_1
          subcounter=0
        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())
                If OpStack()\OperatorLevel=#OpL_0
                  Tokens()\Type=#Token_Function_1
                  Tokens()\Function=OpStack()\Function
                Else
                  Tokens()\Type=#Token_Operator
                  Tokens()\Value=OpStack()\Operator
                EndIf
                DeleteElement(OpStack())
            EndSelect
          Wend
          If mterm=","
            AddElement(OpStack())
            OpStack()\Operator=#Op_BracketOpen
            OpStack()\OperatorLevel=#OpL_1
            thisoplevel=#OpL_1
            lastoplevel=#OpL_1
            subcounter=0
            term=Left(term,counter)+"("+Right(term,Len(term)-counter)
            lterm+1
          EndIf
        Default
          ;Zeichen ist Operator:
          If FindString(#OpL_4$,mterm)
            If lasttokentype Or subcounter=1
              lasterror=#PC_Error_InvalidTerm
              Break
            Else
              thisoplevel=#OpL_4
              lasttokentype=#True
            EndIf
          ElseIf FindString(#OpL_3$,mterm)
            If lasttokentype Or subcounter=1
              lasterror=#PC_Error_InvalidTerm
              Break
            Else
              thisoplevel=#OpL_3
              lasttokentype=#True
            EndIf
          ElseIf FindString(#OpL_2$,mterm)
            If lasttokentype Or subcounter=1
              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
            mterm=Mid(term,counter,counter2-counter)
            counter=counter2-1
            If MatchRegularExpression(0,mterm)
              AddElement(Tokens())
              Tokens()\Type=#Token_Value
              Tokens()\Value=ValD(mterm)
              If counter<lterm And Mid(term,counter+1,1)="("
                term=Left(term,counter)+"*"+Right(term,Len(term)-counter)
                lterm+1
              EndIf
            Else
              If counter<lterm And Mid(term,counter+1,1)="("
                If FindMapElement(FunctionMap(),mterm)
                  function=FunctionMap(mterm)
                Else
                  LastError=#PC_Error_InvalidFunction
                  Break
                EndIf
                thisoplevel=#OpL_0
                AddElement(OpStack())
                OpStack()\OperatorLevel=#OpL_0
                OpStack()\Function=function
                lastoplevel=thisoplevel
                thisoplevel=-1;#OpL_0
                lasttokentype=#True
              Else
                LastError=#PC_Error_InvalidTerm
                Break
              EndIf
            EndIf
          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())
                  If OpStack()\OperatorLevel=#OpL_0
                    Tokens()\Type=#Token_Function_1
                    Tokens()\Function=OpStack()\Function
                  Else
                    Tokens()\Type=#Token_Operator
                    Tokens()\Value=OpStack()\Operator
                  EndIf
                  DeleteElement(OpStack())
                Else
                  Break
                EndIf
              Wend
            EndIf
            AddElement(OpStack())
            OpStack()\Operator=FindString(#Operator,mterm)
            OpStack()\OperatorLevel=thisoplevel
            lastoplevel=thisoplevel
          EndIf
      EndSelect
    counter+1:subcounter+1
  Wend
  
  If LastError<>#PC_Error_NoError
    ProcedureReturn 0
  EndIf
  
  While LastElement(OpStack())
    If OpStack()\Operator<>#Op_BracketOpen
      AddElement(Tokens())
      Select OpStack()\OperatorLevel
        Case #OpL_0
          Tokens()\Type=#Token_Function_1
          Tokens()\Function=OpStack()\Function
        Default
          Tokens()\Type=#Token_Operator
          Tokens()\Value=OpStack()\Operator
      EndSelect
    EndIf
    DeleteElement(OpStack())
  Wend
  ProcedureReturn 1
  
EndProcedure
  Procedure Calculate()
    Protected LeftOp.d,RightOp.d,*element,Op.b
    If ListSize(Tokens())
      FirstElement(Tokens())
      While ListSize(Tokens())>1
        Select Tokens()\Type
          Case #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
          Case #Token_Function_1
            Op=Tokens()\Function
            DeleteElement(Tokens())
            RightOp=Tokens()\Value
            Select Op
              Case #Function_Abs
                Tokens()\Value=Abs(RightOp)
              Case #Function_ACos
                Tokens()\Value=ACos(RightOp)
              Case #Function_ACosH
                Tokens()\Value=ACosH(RightOp)
              Case #Function_ASin
                Tokens()\Value=ASin(RightOp)
              Case #Function_ASinH
                Tokens()\Value=ASinH(RightOp)
              Case #Function_ATan
                Tokens()\Value=ATan(RightOp)
              Case #Function_ATanH
                Tokens()\Value=ATanH(RightOp)
              Case #Function_Cos
                Tokens()\Value=Cos(RightOp)
              Case #Function_CosH
                Tokens()\Value=CosH(RightOp)
              Case #Function_Deg
                Tokens()\Value=Degree(RightOp)
              Case #Function_Exp
                Tokens()\Value=Exp(RightOp)
              Case #Function_Frac
                Tokens()\Value=RightOp-Int(RightOp)
              Case #Function_Int
                Tokens()\Value=Int(RightOp)
              Case #Function_LogTen
                Tokens()\Value=Log10(RightOp)
              Case #Function_LogTwo
                Tokens()\Value=Log(RightOp)
              Case #Function_Neg
                Tokens()\Value=-1*RightOp
              Case #Function_Rad
                Tokens()\Value=Radian(RightOp)
              Case #Function_Sin
                Tokens()\Value=Sin(RightOp)
              Case #Function_SinH
                Tokens()\Value=SinH(RightOp)
              Case #Function_Sqr
                Tokens()\Value=Sqr(RightOp)
              Case #Function_Sqrt
                Tokens()\Value=Pow(RightOp,0.5)
              Case #Function_Tan
                Tokens()\Value=Tan(RightOp)
              Case #Function_TanH
                Tokens()\Value=TanH(RightOp)
            EndSelect
          Default
            If Not NextElement(Tokens())
              LastError=#PC_Error_InvalidNumberOfArguments
              Break
            EndIf
        EndSelect
      Wend
      FirstElement(Tokens())
      ProcedureReturn 1
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  Procedure.d Parse(Term.s,Iterations.q=1)
    Protected It.q
    LastTime=ElapsedMilliseconds()
    For It=1 To Iterations
    
    PreprocessTerm()
    
    If TokenGenerator(term)
      ;     ForEach Tokens()
      ;       Debug Str(Tokens()\Type)+": "+StrD(Tokens()\Value)
      ;     Next
      If Not Calculate()
        LastTime()
        ProcedureReturn
      EndIf
    Else
      LastTime()
      ProcedureReturn
    EndIf
    
    Next
    LastTime()
    ProcedureReturn Tokens()\Value
  EndProcedure
  Procedure.s GetTokens(Term.s)
    Protected result.s
    
    PreprocessTerm()
    
    If TokenGenerator(term)
      ForEach Tokens()
        Select Tokens()\Type
            Case #Token_Value
          result=result+StrD(Tokens()\Value)+" "
        Case #Token_Operator
          result=result+Mid(#Operator,Tokens()\Value,1)+" "
        Case #Token_Function_1
          ForEach FunctionMap()
            If Tokens()\Function=FunctionMap()
              result=result+MapKey(FunctionMap())+" "
              Break
            EndIf
          Next
      EndSelect
      Next
      LastTime()
      ProcedureReturn Left(result,Len(result)-1)
    Else
      LastTime()
      ProcedureReturn
    EndIf
    
  EndProcedure
  Procedure GetLastParserError()
    ProcedureReturn LastError
  EndProcedure
  Procedure GetLastParserTime()
    ProcedureReturn LastTime
  EndProcedure
EndModule

UseModule Purecival
;Parse("18+5*6/8*2-3")
;Debug Parse("(18+36/8*2-3)*(3+2*4)+-111")
;Debug GetTokens("(18+36/8*2-3)*(3+2*4)+-111")

; Debug Parse("-2")
; Debug "LastError: "+Str(GetLastParserError())
; Debug Parse("1.0/2.0")
; Debug "LastError: "+Str(GetLastParserError())
; Debug Parse("-4^2")
; Debug "LastError: "+Str(GetLastParserError())
; Debug Parse("(-4§)^2")
; Debug "LastError: "+Str(GetLastParserError())
; Debug Parse("(-6)*5(-2)")
; Debug "LastError: "+Str(GetLastParserError())
; Debug GetTokens("atan(Cos(0.5)")
; Debug "LastError: "+Str(GetLastParserError())
Debug Parse("int(abs(0.5)")
Debug "LastError: "+Str(GetLastParserError())
Debug "LastTime:  "+Str(GetLastParserTime() )+"ms"
Debug "Ende"
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: RPN Parser

Post by Little John »

jacdelad wrote: Fri Sep 16, 2022 9:31 pm The obvious errors, pointed out by STARGATE, corrected:
You'll find many more test cases here. :-)
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: RPN Parser

Post by STARGÅTE »

Here are some further issues :twisted: :

Code: Select all

Debug Parse("-4^2") ; gives 16, but should be -16 because ^ has higher precedence than -
Debug Parse("2.0e1") ; works fine
Debug Parse("2.0e-1") ; gives NAN, but should be 0.2
Debug Parse("3-(-(-4))") ; gives NAN, but should be -1
Debug Parse("-(-2)") ; gives NAN, but should be 2
Debug Parse("EXP(0.0)") ; gives 0.0, but should be 1.0, probably because of FunctionMap("EXP")=#Function_Deg
Debug Parse("-SQR(4)") ; gives NAN, but should be -2.0
Further you create a regular expression with number 0. However, this is not scoped in the module. This number will be replace, if the user create also a regular expression with number 0. In modules you have to use allways #PB_Any
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

@Little John: Thanks, I'll test them.
@STARGATE: Oh, I didn't know that I have to use #PB_Any in modules. I thought everything is scoped. I'll change that, thanks. Also, I'll check the given examples. There's obviously trouble with all the minuses, I'm not sure how to fix that right now...
Edit: I'll try a preparer, that replaces the negativ "-" with a negation function...
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: RPN Parser

Post by STARGÅTE »

jacdelad wrote: Sat Sep 17, 2022 3:55 pm There's obviously trouble with all the minuses
:lol: The minus sign and the minus operator. That's a fight which all of us have to win when coding a parser. Good luck :wink:
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

STARGÅTE wrote: Sat Sep 17, 2022 4:09 pm
jacdelad wrote: Sat Sep 17, 2022 3:55 pm There's obviously trouble with all the minuses
:lol: The minus sign and the minus operator. That's a fight which all of us have to win when coding a parser. Good luck :wink:
Thanks. I'll post it when it's done.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

Corrected all the inputs STARGATE tortured me with. Please don't do any more testing. :twisted:
Just kidding, every error is another case that I'll make work.

Code: Select all

DeclareModule Purecival
  Declare.d Parse(Term.s,Iterations.q=1)
  Declare.s GetTokens(Term.s)
  Declare GetLastParserError()
  Declare GetLastParserTime()
EndDeclareModule

Module Purecival
  EnableExplicit
  Enumeration Error
    #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), operator at invalid position
    #PC_Error_InvalidFunction          ;Function is invalid
    #PC_Error_InvalidNumberOfArguments ;Invalid number of function arguments
  EndEnumeration
  
  Enumeration Operatorlevel 0
    #OpL_0;Funktionen
    #OpL_1;&%
    #OpL_2;+-
    #OpL_3;*/\
    #OpL_4;^
  EndEnumeration
  Enumeration Operator 1
    #Op_Plus
    #Op_Minus
    #Op_Times
    #Op_Divide
    #Op_Modulo
    #Op_Square
    #Op_BinaryAnd
    #Op_BinaryOr
    #Op_BracketOpen
    #Op_BracketClose
  EndEnumeration
  Enumeration Function 1
    #Function_Abs
    #Function_ACos
    #Function_ACosH
    #Function_ASin
    #Function_ASinH
    #Function_ATan
    #Function_ATanH
    #Function_Cos
    #Function_CosH
    #Function_Deg
    #Function_Exp
    #Function_Frac
    #Function_Int
    #Function_LogTen
    #Function_LogTwo
    #Function_Neg
    #Function_Prime
    #Function_Rad
    #Function_Sin
    #Function_SinH
    #Function_Sqr
    #Function_Sqrt
    #Function_Tan
    #Function_TanH
  EndEnumeration
  Enumeration Token
    #Token_Operator
    #Token_Value
    #Token_Function_1
    #Token_Function_2
  EndEnumeration
  
  #Operator   = "+-*/\^&|"
  #OperatorEx = "+-*/\^&|(),"
  #OpL_1$ = "&|"
  #OpL_2$ = "+-"
  #OpL_3$ = "*/\"
  #OpL_4$ = "^"
  #FunctionList = "Cos|Sin"
  
  Structure Op
    OperatorLevel.a
    StructureUnion
      Operator.a
      Function.i
    EndStructureUnion
  EndStructure
  Structure Token
    Type.a
    StructureUnion
      Value.d
      Function.i
    EndStructureUnion
  EndStructure
  
  Global LastError.a,LastTime.q,RegNum,RegNumVal,NewList Tokens.Token(),NewMap FunctionMap.w()
  FunctionMap("ABS")=#Function_Abs
  FunctionMap("ACOS")=#Function_ACos
  FunctionMap("ACOSH")=#Function_ACosH
  FunctionMap("ASIN")=#Function_ASin
  FunctionMap("ASINH")=#Function_ASinH
  FunctionMap("ATAN")=#Function_ATan
  FunctionMap("ATANH")=#Function_ATanH
  FunctionMap("COS")=#Function_Cos
  FunctionMap("COSH")=#Function_CosH
  FunctionMap("DEG")=#Function_Deg
  FunctionMap("EXP")=#Function_Exp
  FunctionMap("FRAC")=#Function_Frac
  FunctionMap("INT")=#Function_Int
  FunctionMap("LOGTWO")=#Function_LogTwo
  FunctionMap("LOGTEN")=#Function_LogTen
  FunctionMap("NEG")=#Function_Neg
  FunctionMap("PRIME")=#Function_Prime
  FunctionMap("RAD")=#Function_Rad
  FunctionMap("SIN")=#Function_Sin
  FunctionMap("SINH")=#Function_SinH
  FunctionMap("SQR")=#Function_Sqr
  FunctionMap("SQRT")=#Function_Sqrt
  FunctionMap("TAN")=#Function_Tan
  FunctionMap("TANH")=#Function_TanH
  
  RegNum=CreateRegularExpression(#PB_Any,"^[\+\-]??\d*\.??\d+(?:[Ee][\+\-]?\d+)?$")
  RegNumVal=CreateRegularExpression(#PB_Any,"^[\+\-]??\d*\.??\d+(?:[Ee][\+\-]?\d+)?")
  
  Procedure Prime(Input.d)
    Protected f.d=1,n.d=Int(Pow(Input,0.5))
    Select Input
      Case 1
        ProcedureReturn 0
      Case 2,3,5,7
        ProcedureReturn 1
      Default
        If Mod(Input,2)
          Repeat
            f+2
            If Not Mod(Input,f)
              ProcedureReturn 0
            EndIf
          Until f>=n
          ProcedureReturn 1
        Else
          ProcedureReturn 0
        EndIf
    EndSelect
  EndProcedure
  
  Macro LastTime()
    LastTime=ElapsedMilliseconds()-LastTime
  EndMacro
  Macro PreprocessTerm()
    Protected bracket_open.w,bracket_close.w,temp_term.s,temp_counter.w
    LastError=#PC_Error_NoError
    
    ;Term aufbereiten
    term=ReplaceString(term,#TAB$,"")
    term=ReplaceString(term," ","")
    term=ReplaceString(term,"(-","(-1*")
    term=ReplaceString(term,"(+","(+1*")
    term=UCase(term)
    ForEach FunctionMap()
      term=ReplaceString(term,"-"+MapKey(FunctionMap())+"(","-1*"+MapKey(FunctionMap())+"(")
      term=ReplaceString(term,"+"+MapKey(FunctionMap())+"(","+1*"+MapKey(FunctionMap())+"(")
    Next
    Repeat
      Select Left(term,1)
        Case "+"
          term=Right(term,Len(term)-1)
        Case "-"
          ;           If MatchRegularExpression(RegNumVal,term)
          ;             Break
          ;           Else
          term="0"+term
          ;term="-1*"+Right(term,Len(term)-1)
          ;           EndIf
        Default
          Break
      EndSelect
    ForEver
    
    ;Klammern zählen und ausgleichen
    bracket_open=CountString(term,"(")
    bracket_close=CountString(term,")")
    If bracket_close>bracket_open:lasterror=#PC_Error_Bracket:LastTime():ProcedureReturn:EndIf
    If bracket_close<bracket_open:term=LSet(term,Len(term)+bracket_open-bracket_close,")"):EndIf
    term=ReplaceString(term,")(",")*(")
    
    ;Leere Terme filtern
    temp_term=ReplaceString(term,".","")
    temp_term=ReplaceString(temp_term,",","")
    For temp_counter=1 To Len(#OperatorEx)
      temp_term=ReplaceString(temp_term,Mid(#OperatorEx,temp_counter,1),"")
    Next
    If Len(temp_term)=0:lasterror=#PC_Error_EmptyTerm:LastTime():ProcedureReturn:EndIf
  EndMacro
  Procedure TokenGenerator(Term.s)
    Protected NewList OpStack.Op(),counter=1,counter2,lterm=Len(term),lastoplevel.b,mterm.s,thisoplevel.b,lasttokentype.b,subcounter=1,function.i
    ClearList(Tokens())
    While counter<=lterm
      mterm=Mid(term,counter,1)
      Select mterm
        Case "("
          AddElement(OpStack())
          OpStack()\Operator=#Op_BracketOpen
          OpStack()\OperatorLevel=#OpL_1
          thisoplevel=#OpL_1
          lastoplevel=#OpL_1
          lasttokentype=#True
          subcounter=0
        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())
                If OpStack()\OperatorLevel=#OpL_0
                  Tokens()\Type=#Token_Function_1
                  Tokens()\Function=OpStack()\Function
                Else
                  Tokens()\Type=#Token_Operator
                  Tokens()\Value=OpStack()\Operator
                EndIf
                DeleteElement(OpStack())
            EndSelect
          Wend
          If mterm=","
            AddElement(OpStack())
            OpStack()\Operator=#Op_BracketOpen
            OpStack()\OperatorLevel=#OpL_1
            thisoplevel=#OpL_1
            lastoplevel=#OpL_1
            subcounter=0
            term=Left(term,counter)+"("+Right(term,Len(term)-counter)
            lterm+1
          EndIf
        Default
          ;Zeichen ist Operator:
          If FindString(#OpL_4$,mterm)
            If lasttokentype Or subcounter=1
              lasterror=#PC_Error_InvalidTerm
              Break
            Else
              thisoplevel=#OpL_4
              lasttokentype=#True
            EndIf
          ElseIf FindString(#OpL_3$,mterm)
            If lasttokentype Or subcounter=1
              lasterror=#PC_Error_InvalidTerm
              Break
            Else
              thisoplevel=#OpL_3
              lasttokentype=#True
            EndIf
          ElseIf FindString(#OpL_2$,mterm)
            If lasttokentype Or subcounter=1
              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)) And Mid(term,counter2-1,2)<>"E+" And Mid(term,counter2-1,2)<>"E-"
                Break
              EndIf
            Wend
            mterm=Mid(term,counter,counter2-counter)
            counter=counter2-1
            If MatchRegularExpression(RegNum,mterm)
              AddElement(Tokens())
              Tokens()\Type=#Token_Value
              Tokens()\Value=ValD(mterm)
              If counter<lterm And Mid(term,counter+1,1)="("
                term=Left(term,counter)+"*"+Right(term,Len(term)-counter)
                lterm+1
              EndIf
            Else
              If counter<lterm And Mid(term,counter+1,1)="("
                If FindMapElement(FunctionMap(),mterm)
                  function=FunctionMap(mterm)
                Else
                  LastError=#PC_Error_InvalidFunction
                  Break
                EndIf
                thisoplevel=#OpL_0
                AddElement(OpStack())
                OpStack()\OperatorLevel=#OpL_0
                OpStack()\Function=function
                lastoplevel=thisoplevel
                thisoplevel=-1;#OpL_0
                lasttokentype=#True
              Else
                LastError=#PC_Error_InvalidTerm
                Break
              EndIf
            EndIf
          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())
                  If OpStack()\OperatorLevel=#OpL_0
                    Tokens()\Type=#Token_Function_1
                    Tokens()\Function=OpStack()\Function
                  Else
                    Tokens()\Type=#Token_Operator
                    Tokens()\Value=OpStack()\Operator
                  EndIf
                  DeleteElement(OpStack())
                Else
                  Break
                EndIf
              Wend
            EndIf
            AddElement(OpStack())
            OpStack()\Operator=FindString(#Operator,mterm)
            OpStack()\OperatorLevel=thisoplevel
            lastoplevel=thisoplevel
          EndIf
      EndSelect
      counter+1:subcounter+1
    Wend
    
    If LastError<>#PC_Error_NoError
      ProcedureReturn 0
    EndIf
    
    While LastElement(OpStack())
      If OpStack()\Operator<>#Op_BracketOpen
        AddElement(Tokens())
        Select OpStack()\OperatorLevel
          Case #OpL_0
            Tokens()\Type=#Token_Function_1
            Tokens()\Function=OpStack()\Function
          Default
            Tokens()\Type=#Token_Operator
            Tokens()\Value=OpStack()\Operator
        EndSelect
      EndIf
      DeleteElement(OpStack())
    Wend
    ProcedureReturn 1
    
  EndProcedure
  Procedure Calculate()
    Protected LeftOp.d,RightOp.d,*element,Op.b
    If ListSize(Tokens())
      FirstElement(Tokens())
      While ListSize(Tokens())>1
        Select Tokens()\Type
          Case #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
          Case #Token_Function_1
            Op=Tokens()\Function
            DeleteElement(Tokens())
            Select Op
              Case #Function_Abs
                Tokens()\Value=Abs(Tokens()\Value)
              Case #Function_ACos
                Tokens()\Value=ACos(Tokens()\Value)
              Case #Function_ACosH
                Tokens()\Value=ACosH(Tokens()\Value)
              Case #Function_ASin
                Tokens()\Value=ASin(Tokens()\Value)
              Case #Function_ASinH
                Tokens()\Value=ASinH(Tokens()\Value)
              Case #Function_ATan
                Tokens()\Value=ATan(Tokens()\Value)
              Case #Function_ATanH
                Tokens()\Value=ATanH(Tokens()\Value)
              Case #Function_Cos
                Tokens()\Value=Cos(Tokens()\Value)
              Case #Function_CosH
                Tokens()\Value=CosH(Tokens()\Value)
              Case #Function_Deg
                Tokens()\Value=Degree(Tokens()\Value)
              Case #Function_Exp
                Tokens()\Value=Exp(Tokens()\Value)
              Case #Function_Frac
                Tokens()\Value=Tokens()\Value-Int(Tokens()\Value)
              Case #Function_Int
                Tokens()\Value=Int(Tokens()\Value)
              Case #Function_LogTen
                Tokens()\Value=Log10(Tokens()\Value)
              Case #Function_LogTwo
                Tokens()\Value=Log(Tokens()\Value)
              Case #Function_Neg
                Tokens()\Value=-1*Tokens()\Value
              Case #Function_Prime
                Tokens()\Value=Prime(Int(Tokens()\Value))
              Case #Function_Rad
                Tokens()\Value=Radian(Tokens()\Value)
              Case #Function_Sin
                Tokens()\Value=Sin(Tokens()\Value)
              Case #Function_SinH
                Tokens()\Value=SinH(Tokens()\Value)
              Case #Function_Sqr
                Tokens()\Value=Sqr(Tokens()\Value)
              Case #Function_Sqrt
                Tokens()\Value=Pow(Tokens()\Value,0.5)
              Case #Function_Tan
                Tokens()\Value=Tan(Tokens()\Value)
              Case #Function_TanH
                Tokens()\Value=TanH(Tokens()\Value)
            EndSelect
          Default
            If Not NextElement(Tokens())
              LastError=#PC_Error_InvalidNumberOfArguments
              Break
            EndIf
        EndSelect
      Wend
      FirstElement(Tokens())
      ProcedureReturn 1
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  Procedure.d Parse(Term.s,Iterations.q=1)
    Protected It.q
    LastTime=ElapsedMilliseconds()
    For It=1 To Iterations
      
      PreprocessTerm()
      
      If TokenGenerator(term)
        ;     ForEach Tokens()
        ;       Debug Str(Tokens()\Type)+": "+StrD(Tokens()\Value)
        ;     Next
        If Not Calculate()
          LastTime()
          ProcedureReturn
        EndIf
      Else
        LastTime()
        ProcedureReturn
      EndIf
      
    Next
    LastTime()
    ProcedureReturn Tokens()\Value
  EndProcedure
  Procedure.s GetTokens(Term.s)
    Protected result.s
    
    PreprocessTerm()
    
    If TokenGenerator(term)
      ForEach Tokens()
        Select Tokens()\Type
          Case #Token_Value
            result=result+StrD(Tokens()\Value)+" "
          Case #Token_Operator
            result=result+Mid(#Operator,Tokens()\Value,1)+" "
          Case #Token_Function_1
            ForEach FunctionMap()
              If Tokens()\Function=FunctionMap()
                result=result+MapKey(FunctionMap())+" "
                Break
              EndIf
            Next
        EndSelect
      Next
      LastTime()
      ProcedureReturn Left(result,Len(result)-1)
    Else
      LastTime()
      ProcedureReturn
    EndIf
    
  EndProcedure
  Procedure GetLastParserError()
    ProcedureReturn LastError
  EndProcedure
  Procedure GetLastParserTime()
    ProcedureReturn LastTime
  EndProcedure
EndModule

UseModule Purecival

Debug Parse("-4^2") ; gives 16, but should be -16 because ^ has higher precedence than -
Debug Parse("2.0e1"); works fine
Debug Parse("2.0e-1") ; gives NAN, but should be 0.2
Debug Parse("3-(-(-4))") ; gives NAN, but should be -1
Debug Parse("-(-2)")     ; gives NAN, but should be 2
Debug Parse("EXP(0.0)")  ; gives 0.0, but should be 1.0, probably because of FunctionMap("EXP")=#Function_Deg
Debug Parse("-SQR(4)")   ; gives NAN, but should be -2.0

Debug "End"
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: RPN Parser

Post by jacdelad »

The crucial point is, like STARGATE noticed, splitting the term. The calculation afterwards isn't too hard. I wrote a new term splitter, which splits the term into its pieces (numbers and operations, brackets...). This is not implemented into the calculation, but it will be, because now it's much easier. However, feel free to test it with every crooked, but valid formula to test its power:

Code: Select all

DeclareModule Purecival
  Declare.d Parse(Term.s)
  Declare.s GetTokens(Term.s)
  Declare GetLastParserError()
  Declare GetLastParserTime()
EndDeclareModule

Module Purecival
  EnableExplicit
  Enumeration Error
    #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), operator at invalid position
    #PC_Error_InvalidFunction          ;Function is invalid
    #PC_Error_InvalidNumberOfArguments ;Invalid number of function arguments
  EndEnumeration
  
  Enumeration Operatorlevel 0
    #OpL_0;Funktionen
    #OpL_1;&%
    #OpL_2;+-
    #OpL_3;*/\
    #OpL_4;^
  EndEnumeration
  Enumeration Operator 1
    #Op_Plus
    #Op_Minus
    #Op_Times
    #Op_Divide
    #Op_Modulo
    #Op_Square
    #Op_BinaryAnd
    #Op_BinaryOr
    #Op_BracketOpen
    #Op_BracketClose
  EndEnumeration
  Enumeration Function 1
    #Function_Abs
    #Function_ACos
    #Function_ACosH
    #Function_ASin
    #Function_ASinH
    #Function_ATan
    #Function_ATanH
    #Function_Cos
    #Function_CosH
    #Function_Deg
    #Function_Exp
    #Function_Frac
    #Function_Int
    #Function_LogTen
    #Function_LogTwo
    #Function_Neg
    #Function_Prime
    #Function_Rad
    #Function_Sin
    #Function_SinH
    #Function_Sqr
    #Function_Sqrt
    #Function_Tan
    #Function_TanH
  EndEnumeration
  Enumeration Token
    #Token_Operator
    #Token_Value
    #Token_Function_1
    #Token_Function_2
  EndEnumeration
  
  #Operator   = "+-*/\^&|"
  #OperatorEx = "+-*/\^&|(),"
  #OpL_1$ = "&|"
  #OpL_2$ = "+-"
  #OpL_3$ = "*/\"
  #OpL_4$ = "^"
  #FunctionList = "Cos|Sin"
  
  Structure Op
    OperatorLevel.a
    StructureUnion
      Operator.a
      Function.i
    EndStructureUnion
  EndStructure
  Structure Token
    Type.a
    StructureUnion
      Value.d
      Function.i
    EndStructureUnion
  EndStructure
  
  Global LastError.a,LastTime.q,RegNum,RegNumVal,NewList Tokens.Token(),NewMap FunctionMap.w(),NewList SplittedTerm.s()
  FunctionMap("ABS")=#Function_Abs
  FunctionMap("ACOS")=#Function_ACos
  FunctionMap("ACOSH")=#Function_ACosH
  FunctionMap("ASIN")=#Function_ASin
  FunctionMap("ASINH")=#Function_ASinH
  FunctionMap("ATAN")=#Function_ATan
  FunctionMap("ATANH")=#Function_ATanH
  FunctionMap("COS")=#Function_Cos
  FunctionMap("COSH")=#Function_CosH
  FunctionMap("DEG")=#Function_Deg
  FunctionMap("EXP")=#Function_Exp
  FunctionMap("FRAC")=#Function_Frac
  FunctionMap("INT")=#Function_Int
  FunctionMap("LOGTWO")=#Function_LogTwo
  FunctionMap("LOGTEN")=#Function_LogTen
  FunctionMap("NEG")=#Function_Neg
  FunctionMap("PRIME")=#Function_Prime
  FunctionMap("RAD")=#Function_Rad
  FunctionMap("SIN")=#Function_Sin
  FunctionMap("SINH")=#Function_SinH
  FunctionMap("SQR")=#Function_Sqr
  FunctionMap("SQRT")=#Function_Sqrt
  FunctionMap("TAN")=#Function_Tan
  FunctionMap("TANH")=#Function_TanH
  
  RegNum   =CreateRegularExpression(#PB_Any,"^[\+\-]??\d*\.??\d+(?:[Ee][\+\-]?\d+)?$")
  RegNumVal=CreateRegularExpression(#PB_Any,"^[\+\-]??\d*\.??\d+(?:[Ee][\+\-]?\d+)?" )
  
  ;Mathematische Funktionen
  Procedure Prime(Input.d)
    Protected f.d=1,n.d=Int(Pow(Input,0.5))
    Select Input
      Case 1
        ProcedureReturn 0
      Case 2,3,5,7
        ProcedureReturn 1
      Default
        If Mod(Input,2)
          Repeat
            f+2
            If Not Mod(Input,f)
              ProcedureReturn 0
            EndIf
          Until f>=n
          ProcedureReturn 1
        Else
          ProcedureReturn 0
        EndIf
    EndSelect
  EndProcedure
  
  ;Interne Funktionen und Makros
  Procedure SplitTerm(Term.s)
    Protected count=1,lterm=Len(Term),LastAdd,STemp.s
    ClearList(SplittedTerm())
    
    Repeat
      Select Mid(Term,count,1)
      Case "+","-"
        If LastAdd
          If ExamineRegularExpression(RegNumVal,Right(Term,lterm-count+1)) And NextRegularExpressionMatch(RegNumVal)
            AddElement(SplittedTerm())
            SplittedTerm()=RegularExpressionMatchString(RegNumVal)
            count+RegularExpressionMatchLength(RegNumVal)
            LastAdd=#False
          EndIf
        Else
          AddElement(SplittedTerm())
          SplittedTerm()=Mid(Term,count,1)
          count+1
          LastAdd=#True
        EndIf
      Case "*","/","^","(",")",","
        AddElement(SplittedTerm())
        SplittedTerm()=Mid(Term,count,1)
        count+1
        LastAdd=#True
      Case "!"
        If count=1
          AddElement(SplittedTerm())
          SplittedTerm()="Error!"
          Break
        Else
          AddElement(SplittedTerm())
          SplittedTerm()=Mid(Term,count,1)
          count+1
          LastAdd=#False
        EndIf
      Default
        If ExamineRegularExpression(RegNumVal,Right(Term,lterm-count+1)) And NextRegularExpressionMatch(RegNumVal)
          AddElement(SplittedTerm())
          SplittedTerm()=RegularExpressionMatchString(RegNumVal)
          count+RegularExpressionMatchLength(RegNumVal)
          LastAdd=#False
        Else
          LastAdd=#True
          ForEach FunctionMap()
            Stemp=MapKey(FunctionMap())+"("
            If Mid(Term,count,Len(Stemp))=Stemp
              AddElement(SplittedTerm())
              SplittedTerm()=MapKey(FunctionMap())
              AddElement(SplittedTerm())
              SplittedTerm()="("
              count+Len(Stemp)
              LastAdd=#False
              Break
            EndIf
          Next
          If LastAdd
            AddElement(SplittedTerm())
            SplittedTerm()="Error!"
            Break
          EndIf
        EndIf
    EndSelect
    Until count>lterm
    
    Protected NeuTerm.s
    ForEach SplittedTerm()
      neuterm+SplittedTerm()+" "
    Next
    Debug "Term: "+Term
    Debug "SplitTerm: "+neuterm
  EndProcedure
  Macro LastTime()
    LastTime=ElapsedMilliseconds()-LastTime
  EndMacro
  Macro PreprocessTerm()
    Protected bracket_open.w,bracket_close.w,temp_term.s,temp_counter.w
    LastError=#PC_Error_NoError
    
    ;Term aufbereiten
    term=ReplaceString(term,#TAB$,"")
    term=ReplaceString(term," ","")
    term=ReplaceString(term,"(-","(-1*")
    term=ReplaceString(term,"(+","(+1*")
    term=UCase(term)
    ForEach FunctionMap()
      term=ReplaceString(term,"-"+MapKey(FunctionMap())+"(","-1*"+MapKey(FunctionMap())+"(")
      term=ReplaceString(term,"+"+MapKey(FunctionMap())+"(","+1*"+MapKey(FunctionMap())+"(")
    Next
    Repeat
      Select Left(term,1)
        Case "+"
          term=Right(term,Len(term)-1)
        Case "-"
          term="0"+term
        Default
          Break
      EndSelect
    ForEver
    
    ;Term splitten (für bessere Verarbeitung)
    SplitTerm(Term)
    
    ;Klammern zählen und ausgleichen
    bracket_open=CountString(term,"(")
    bracket_close=CountString(term,")")
    If bracket_close>bracket_open:lasterror=#PC_Error_Bracket:LastTime():ProcedureReturn:EndIf
    If bracket_close<bracket_open:term=LSet(term,Len(term)+bracket_open-bracket_close,")"):EndIf
    term=ReplaceString(term,")(",")*(")
    
    ;Leere Terme filtern
    temp_term=ReplaceString(term,".","")
    temp_term=ReplaceString(temp_term,",","")
    For temp_counter=1 To Len(#OperatorEx)
      temp_term=ReplaceString(temp_term,Mid(#OperatorEx,temp_counter,1),"")
    Next
    If Len(temp_term)=0:lasterror=#PC_Error_EmptyTerm:LastTime():ProcedureReturn:EndIf
  EndMacro
  Procedure TokenGenerator(Term.s)
    Protected NewList OpStack.Op(),counter=1,counter2,lterm=Len(term),lastoplevel.b,mterm.s,thisoplevel.b,lasttokentype.b,subcounter=1,function.i
    ClearList(Tokens())
    While counter<=lterm
      mterm=Mid(term,counter,1)
      Select mterm
        Case "("
          AddElement(OpStack())
          OpStack()\Operator=#Op_BracketOpen
          OpStack()\OperatorLevel=#OpL_1
          thisoplevel=#OpL_1
          lastoplevel=#OpL_1
          lasttokentype=#True
          subcounter=0
        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())
                If OpStack()\OperatorLevel=#OpL_0
                  Tokens()\Type=#Token_Function_1
                  Tokens()\Function=OpStack()\Function
                Else
                  Tokens()\Type=#Token_Operator
                  Tokens()\Value=OpStack()\Operator
                EndIf
                DeleteElement(OpStack())
            EndSelect
          Wend
          If mterm=","
            AddElement(OpStack())
            OpStack()\Operator=#Op_BracketOpen
            OpStack()\OperatorLevel=#OpL_1
            thisoplevel=#OpL_1
            lastoplevel=#OpL_1
            subcounter=0
            term=Left(term,counter)+"("+Right(term,Len(term)-counter)
            lterm+1
          EndIf
        Default
          ;Zeichen ist Operator:
          If FindString(#OpL_4$,mterm)
            If lasttokentype Or subcounter=1
              lasterror=#PC_Error_InvalidTerm
              Break
            Else
              thisoplevel=#OpL_4
              lasttokentype=#True
            EndIf
          ElseIf FindString(#OpL_3$,mterm)
            If lasttokentype Or subcounter=1
              lasterror=#PC_Error_InvalidTerm
              Break
            Else
              thisoplevel=#OpL_3
              lasttokentype=#True
            EndIf
          ElseIf FindString(#OpL_2$,mterm)
            If lasttokentype Or subcounter=1
              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)) And Mid(term,counter2-1,2)<>"E+" And Mid(term,counter2-1,2)<>"E-"
                Break
              EndIf
            Wend
            mterm=Mid(term,counter,counter2-counter)
            counter=counter2-1
            If MatchRegularExpression(RegNum,mterm)
              AddElement(Tokens())
              Tokens()\Type=#Token_Value
              Tokens()\Value=ValD(mterm)
              If counter<lterm And Mid(term,counter+1,1)="("
                term=Left(term,counter)+"*"+Right(term,Len(term)-counter)
                lterm+1
              EndIf
            Else
              If counter<lterm And Mid(term,counter+1,1)="("
                If FindMapElement(FunctionMap(),mterm)
                  function=FunctionMap(mterm)
                Else
                  LastError=#PC_Error_InvalidFunction
                  Break
                EndIf
                thisoplevel=#OpL_0
                AddElement(OpStack())
                OpStack()\OperatorLevel=#OpL_0
                OpStack()\Function=function
                lastoplevel=thisoplevel
                thisoplevel=-1;#OpL_0
                lasttokentype=#True
              Else
                LastError=#PC_Error_InvalidTerm
                Break
              EndIf
            EndIf
          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())
                  If OpStack()\OperatorLevel=#OpL_0
                    Tokens()\Type=#Token_Function_1
                    Tokens()\Function=OpStack()\Function
                  Else
                    Tokens()\Type=#Token_Operator
                    Tokens()\Value=OpStack()\Operator
                  EndIf
                  DeleteElement(OpStack())
                Else
                  Break
                EndIf
              Wend
            EndIf
            AddElement(OpStack())
            OpStack()\Operator=FindString(#Operator,mterm)
            OpStack()\OperatorLevel=thisoplevel
            lastoplevel=thisoplevel
          EndIf
      EndSelect
      counter+1:subcounter+1
    Wend
    
    If LastError<>#PC_Error_NoError
      ProcedureReturn 0
    EndIf
    
    While LastElement(OpStack())
      If OpStack()\Operator<>#Op_BracketOpen
        AddElement(Tokens())
        Select OpStack()\OperatorLevel
          Case #OpL_0
            Tokens()\Type=#Token_Function_1
            Tokens()\Function=OpStack()\Function
          Default
            Tokens()\Type=#Token_Operator
            Tokens()\Value=OpStack()\Operator
        EndSelect
      EndIf
      DeleteElement(OpStack())
    Wend
    ProcedureReturn 1
    
  EndProcedure
  Procedure Calculate()
    Protected LeftOp.d,RightOp.d,*element,Op.b
    If ListSize(Tokens())
      FirstElement(Tokens())
      While ListSize(Tokens())>1
        Select Tokens()\Type
          Case #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
          Case #Token_Function_1
            Op=Tokens()\Function
            DeleteElement(Tokens())
            Select Op
              Case #Function_Abs
                Tokens()\Value=Abs(Tokens()\Value)
              Case #Function_ACos
                Tokens()\Value=ACos(Tokens()\Value)
              Case #Function_ACosH
                Tokens()\Value=ACosH(Tokens()\Value)
              Case #Function_ASin
                Tokens()\Value=ASin(Tokens()\Value)
              Case #Function_ASinH
                Tokens()\Value=ASinH(Tokens()\Value)
              Case #Function_ATan
                Tokens()\Value=ATan(Tokens()\Value)
              Case #Function_ATanH
                Tokens()\Value=ATanH(Tokens()\Value)
              Case #Function_Cos
                Tokens()\Value=Cos(Tokens()\Value)
              Case #Function_CosH
                Tokens()\Value=CosH(Tokens()\Value)
              Case #Function_Deg
                Tokens()\Value=Degree(Tokens()\Value)
              Case #Function_Exp
                Tokens()\Value=Exp(Tokens()\Value)
              Case #Function_Frac
                Tokens()\Value=Tokens()\Value-Int(Tokens()\Value)
              Case #Function_Int
                Tokens()\Value=Int(Tokens()\Value)
              Case #Function_LogTen
                Tokens()\Value=Log10(Tokens()\Value)
              Case #Function_LogTwo
                Tokens()\Value=Log(Tokens()\Value)
              Case #Function_Neg
                Tokens()\Value=-1*Tokens()\Value
              Case #Function_Prime
                Tokens()\Value=Prime(Int(Tokens()\Value))
              Case #Function_Rad
                Tokens()\Value=Radian(Tokens()\Value)
              Case #Function_Sin
                Tokens()\Value=Sin(Tokens()\Value)
              Case #Function_SinH
                Tokens()\Value=SinH(Tokens()\Value)
              Case #Function_Sqr
                Tokens()\Value=Sqr(Tokens()\Value)
              Case #Function_Sqrt
                Tokens()\Value=Pow(Tokens()\Value,0.5)
              Case #Function_Tan
                Tokens()\Value=Tan(Tokens()\Value)
              Case #Function_TanH
                Tokens()\Value=TanH(Tokens()\Value)
            EndSelect
          Default
            If Not NextElement(Tokens())
              LastError=#PC_Error_InvalidNumberOfArguments
              Break
            EndIf
        EndSelect
      Wend
      FirstElement(Tokens())
      ProcedureReturn 1
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  ;Öffentliche Funktionen
  Procedure.d Parse(Term.s)
    LastTime=ElapsedMilliseconds()
    PreprocessTerm()
    
    If TokenGenerator(term)
      ;     ForEach Tokens()
      ;       Debug Str(Tokens()\Type)+": "+StrD(Tokens()\Value)
      ;     Next
      If Not Calculate()
        LastTime()
        ProcedureReturn
      EndIf
    Else
      LastTime()
      ProcedureReturn
    EndIf
    
    LastTime()
    ProcedureReturn Tokens()\Value
  EndProcedure
  Procedure.s GetTokens(Term.s)
    Protected result.s
    
    PreprocessTerm()
    
    If TokenGenerator(term)
      ForEach Tokens()
        Select Tokens()\Type
          Case #Token_Value
            result=result+StrD(Tokens()\Value)+" "
          Case #Token_Operator
            result=result+Mid(#Operator,Tokens()\Value,1)+" "
          Case #Token_Function_1
            ForEach FunctionMap()
              If Tokens()\Function=FunctionMap()
                result=result+MapKey(FunctionMap())+" "
                Break
              EndIf
            Next
        EndSelect
      Next
      LastTime()
      ProcedureReturn Left(result,Len(result)-1)
    Else
      LastTime()
      ProcedureReturn
    EndIf
    
  EndProcedure
  Procedure GetLastParserError()
    ProcedureReturn LastError
  EndProcedure
  Procedure GetLastParserTime()
    ProcedureReturn LastTime
  EndProcedure
EndModule

UseModule Purecival

Debug Parse("-4^2") ; gives 16, but should be -16 because ^ has higher precedence than -
Debug Parse("2.0e1"); works fine
Debug Parse("2.0e-1") ; gives NAN, but should be 0.2
Debug Parse("3-(-(-4))") ; gives NAN, but should be -1
Debug Parse("-(-2)")     ; gives NAN, but should be 2
Debug Parse("EXP(0.0)")  ; gives 0.0, but should be 1.0, probably because of FunctionMap("EXP")=#Function_Deg
Debug Parse("-SQR(4)")   ; gives NAN, but should be -2.0
Debug Parse("4+8!-6!-4")   ; just for testing the new term splitter, ! is not implemented yet

Debug "End"
The "SplitTerm: "-output should split the term into its atoms, separated by spaces.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
Post Reply