Evaluate Function For Math Library

Got an idea for enhancing PureBasic? New command(s) you'd like to see?
Post Reply
User avatar
spikey
Enthusiast
Enthusiast
Posts: 793
Joined: Wed Sep 22, 2010 1:17 pm
Location: United Kingdom

Evaluate Function For Math Library

Post by spikey »

It would be useful to have an Evaluate() function in the Math library for ad hoc calculations at runtime. I found this. It's free, open source, small, dependency free, thread safe and has a permissive license:
https://codeplea.com/tinyexpr

For example in Affinity Photo I can put something like this in the X co-ordinate box:

Code: Select all

(3888/2) - 200
which would move an object 200 pixels left of the centre of a photo from my camera.

I thought it might be nice to add this sort of capability to the form designer's property panel.
Top
User avatar
idle
Always Here
Always Here
Posts: 6154
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Evaluate Function For Math Library

Post by idle »

pb native

Code: Select all

; Author: IDLE
; Date 17,1,2026 
;  PB version: v6.30 windows
; updated for 6.30 Mk-Soft 
; Date: 11,10,2019
; PB version: v5.62 windows 
; Version 0.53
; Updated for PB 5.62 
; added fix for unary negation 
; Date: 26,4, 2011
; PB version: v4.51 linux

; Version 0.52  
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; RPN interpretor (Reverse Polish Notation) 
; parse infix to RPN and calculates results 
; http://en.wikipedia.org/wiki/Reverse_Polish_notation 
; supported operators
; + - * / "% ^ << >>
; ~ ! | &  bitwise 
; > < >= <= <> ==  ternary operators  eg a > b ? x : y  or  a > b : x : y  or a > b x y   
; sin cos tan sqrt
; variables numeric and strings 
EnableExplicit 

Enumeration 10
  #RPN_IsNumeric
  #RPN_IsAlpha
  #RPN_IsSymbol 
  #RPN_IsOther 
EndEnumeration

Structure RPN_Variables     
  len.i
  type.i
  num.d
  str.s
EndStructure

Structure RPN_Class
  *vt
  StackCounter.i
  rpn.s
  Map tokens.i()
  Map var.RPN_Variables()
  List stack.s()
EndStructure   

Interface IRPN 
  Eval.s(expr.s) 
  IsNumeric(expr.s) 
  Free() 
EndInterface   

Procedure NewRPN() 
  Protected *this.RPN_Class 
  *this = AllocateStructure(RPN_Class) 
  If *this 
    *this\tokens("(") =1
    *this\tokens("+") =4
    *this\tokens("-")=4
    *this\tokens("_")=8
    *this\tokens("*")=5
    *this\tokens("/")=5
    *this\tokens("%")=7
    *this\tokens("^")=5
    *this\tokens(">>")=7
    *this\tokens("<<")=7
    *this\tokens("!")=6
    *this\tokens("&")=6
    *this\tokens("|")=6
    *this\tokens("~")=8
    *this\tokens("=")=8
    *this\tokens(">")=4
    *this\tokens("<")=4
    *this\tokens(">=")=4
    *this\tokens("<=")=4
    *this\tokens("<>")=4
    *this\tokens("==")=4 
    *this\tokens(")")=1
    *this\tokens("sin")=5
    *this\tokens("cos")=5
    *this\tokens("tan")=5
    *this\tokens("?")=0
    *this\tokens(":")=0
    *this\tokens("sqrt")=5
    *this\vt = ?VT_RPN 
    ProcedureReturn *this 
  EndIf   

EndProcedure  

Procedure RPN_Free(*this)
  ClearStructure(*this,RPN_Class) 
  FreeStructure(*this) 
EndProcedure 

Procedure RPN_IsNumeric(*this,strin.s) 
  Protected char.i
  If strin <> ""
  char = PeekC(@strin)
  If char = 45 Or (char >=48 And char <=57) 
    ProcedureReturn 1
  Else  
    ProcedureReturn 0
  EndIf      
  EndIf 
EndProcedure

Procedure RPN_NewVar(*this.RPN_Class,v.s,val.s)
  Protected *v
  
  If RPN_IsNumeric(*this,val)  
    *this\var(v)\num = ValD(val) 
    *this\var(v)\len = SizeOf(Double)
    *this\var(v)\type = #RPN_IsNumeric
  Else 
    *this\var(v)\str = val 
    *this\var(v)\type = #RPN_IsAlpha
    *this\var(v)\len = Len(val) 
  EndIf   
  
EndProcedure 

Procedure RPN_SetVar(*this.RPN_Class,v.s,val.s)
  Protected *v,va.s,type.s
  
  If Not *this\var(v)\len
    RPN_NewVar(*this,v,val)
  Else 
    If *this\var(v)\type = #RPN_IsNumeric  
      *this\var(v)\num = ValD(val)
    Else 
      *this\var(v)\str = val 
      *this\var(v)\len = Len(val) 
    EndIf    
    
  EndIf   
EndProcedure 

Procedure RPN_Push(*this.RPN_Class,token.s)
  Static ct,top.s
  If token = "("
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  ElseIf *this\StackCounter = 0   
    AddElement(*this\stack())
    *this\stack()= token
    *this\StackCounter+1
  Else
    top = *this\stack()
    While *this\tokens(top) > *this\tokens(token) And *this\StackCounter > 0
      *this\rpn + *this\stack() + " "
      DeleteElement(*this\stack())
      *this\StackCounter-1
    Wend
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  EndIf
  
EndProcedure

Procedure RPN_Pop(*this.RPN_Class,cond.s)
  Protected token.s
  While *this\StackCounter > 0
    token = *this\stack()
    If token = cond
      DeleteElement(*this\stack())
      *this\StackCounter-1
      Break
    Else
      *this\rpn + token + " "
    EndIf
    DeleteElement(*this\stack())
    *this\StackCounter-1
  Wend
EndProcedure

Procedure RPN_InfixToRpn(*this.RPN_Class,expr.s)
  Protected len,a,b,c,char,state,token.s,Tstate,lstate,ltoken.s 
  
  len = StringByteLength(expr)
  
  While a < len 
    b=a
    token=""
    While b < len
      char = PeekC(@expr+b)
      If (char = '.' And state = #RPN_IsNumeric) Or (char >='0' And char <='9') 
        state = #RPN_IsNumeric
      ElseIf (char = '.' And state = #RPN_IsAlpha) Or (char >='A' And char <='Z')  
        state = #RPN_IsAlpha 
      ElseIf char >='a' And char <='z'
        state = #RPN_IsAlpha 
      ElseIf char <> ' '  
        state = #RPN_IsSymbol
      Else 
        state = #RPN_IsOther
      EndIf 
      If Not Tstate 
        Tstate = state 
      EndIf   
      If Tstate <> state 
        Break
      Else 
        token + Chr(char)
        If (char >= '(') And (char <='+') Or char = '-' Or char = '/' Or char = '=' Or char ='!' Or char = '^' Or char = '_' Or char = '~'
          b+SizeOf(Character)
          Break 
        EndIf    
      EndIf   
      b+SizeOf(Character)
    Wend       
    a=b      
    
    If Tstate = #RPN_IsSymbol
      If token = ")"
        RPN_Pop(*this,"(")
      ElseIf *this\tokens(token)
        If ((lstate = #RPN_IsSymbol Or lstate =0) And token = "-")  
          If (ltoken <> ")" And Not RPN_IsNumeric(*this,ltoken))
            token = "_"
          EndIf   
        EndIf   
        RPN_Push(*this,token)
      EndIf   
    ElseIf tstate = #RPN_IsAlpha
      If *this\tokens(token)
        RPN_Push(*this,token)
      Else 
        *this\Rpn + token + " "   
      EndIf    
    ElseIf tState = #RPN_IsNumeric 
      *this\Rpn + token + " "   
    EndIf   
    Tstate = state
    lstate = state  
    ltoken = token
  Wend   
  RPN_Pop(*this,"end")
  *this\rpn = Trim(*this\rpn)
  
EndProcedure

Macro _RPN_Pop(op,v)
  If ListSize(*this\stack()) > 0
    op = *this\stack()
    If *this\var(op)\type > 0
      *v = @*this\var(op)
      vr\type = #RPN_IsNumeric 
    Else   
      If RPN_IsNumeric(*this,op)
        *v = @t#v
        *v\num = ValD(op)
        *v\str = ""
        *v\type = #RPN_IsNumeric 
        vr\type =#RPN_IsNumeric 
      Else  
        *v = @t#v
        *v\num = 0
        *v\str = op
        *v\type = #RPN_IsAlpha
        vr\type =#RPN_IsAlpha
      EndIf  
    EndIf   
    DeleteElement(*this\stack())
  EndIf   
EndMacro

Macro _RPN_Assign(cond)
  If cond
    If *v2\type = #RPN_IsNumeric 
      vr\num = *v2\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str
    EndIf   
  Else
    If *v1\type = #RPN_IsNumeric
      vr\num = *v1\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v1\str
    EndIf
  EndIf    
EndMacro 

Procedure RPN_EvalOperator(*this.RPN_Class,operator.s)
  Protected op1.s,op2.s,op3.s,op4.s,result.s
  Protected t1.q,tq.q,rq.q,t2
  Protected *v1.RPN_Variables,*v2.RPN_Variables,*v3.RPN_Variables,*v4.RPN_Variables 
  Protected tv1.RPN_Variables,tv2.RPN_Variables,tv3.RPN_Variables,tv4.RPN_Variables
  Protected vr.RPN_Variables 
  _RPN_Pop(op1,v1)
  If operator <> "~" And operator <> "sin" And operator <> "cos" And operator <> "tan" And  operator <> "sqrt" And operator <> "_"
    _RPN_Pop(op2,v2)
    If op2 <> ""
      *this\StackCounter-2
    Else 
      *this\StackCounter-1
    EndIf   
  Else
    *this\StackCounter-1
  EndIf
  If operator = "+"
    If *v1\type = #RPN_IsNumeric And  *v2\type = #RPN_IsNumeric
      vr\num = *v2\num + *v1\num 
      vr\type = #RPN_IsNumeric
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str + *v1\str 
    EndIf   
  ElseIf  operator = "-"
    If op2 <> ""
      vr\num = *v2\num - *v1\num
    Else 
      vr\num = -*v1\num  
    EndIf  
  ElseIf operator = "*"
    vr\num = *v2\num * *v1\num
  ElseIf operator = "/"
    If *v1\num <> 0
      vr\num = *v2\num / *v1\num
    EndIf   
  ElseIf operator = "%"
    vr\num =Mod(*v2\num,*v1\num)
  ElseIf operator = "^"
    vr\num = Pow(*v2\num,*v1\num)
  ElseIf operator =">"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num > *v3\num)
  ElseIf operator ="<"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num < *v3\num)
  ElseIf operator =">="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num >= *v3\num)
  ElseIf operator ="<="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num <= *v3\num)
  ElseIf operator ="<>"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num <> *v3\num)
    Else
      _RPN_Assign(*v4\str <> *v3\str)
    EndIf 
  ElseIf operator ="=="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num = *v3\num)
    Else
      _RPN_Assign(*v4\str = *v3\str)
    EndIf 
  ElseIf operator =">>"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 >> t1
    vr\num = rq
  ElseIf operator ="<<"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 << t1
    vr\num = rq
  ElseIf operator ="!"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 ! t1
    vr\num = rq
  ElseIf operator ="&"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 & t1
    vr\num = rq
  ElseIf operator ="|"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 | t1
    vr\num = rq   
  ElseIf operator ="~"
    t1 = *v1\num
    rq = ~t1
    vr\num = rq
  ElseIf operator ="_"
    t1 = *v1\num
    rq = -t1
    vr\num = rq  
  ElseIf operator ="sin"
    vr\num = Sin(*v1\num)
  ElseIf operator ="cos"
    vr\num = Cos(*v1\num)
  ElseIf operator ="tan"
    vr\num = Tan(*v1\num)
  ElseIf  operator = "sqrt"
    vr\num = Sqr(*v1\num)
  EndIf   
  If operator = "="
    If *v2 And *v2\type = #RPN_IsNumeric  
      RPN_SetVar(*this,op1,op2)
    Else
      RPN_SetVar(*this,op2,op1)
    EndIf   
  Else
    If vr\type = #RPN_IsNumeric
      result = StrD(vr\num)
    Else 
      result = vr\str
    EndIf   
    AddElement(*this\stack())
    *this\stack() = result
    *this\StackCounter+1
  EndIf
EndProcedure

Procedure.s RPN_Eval(*this.RPN_Class,expr.s)
  Protected token.s,len,ct,a,result.s
  
  ClearList(*this\stack())
  ClearMap(*this\var())
  *this\StackCounter=0
  *this\rpn = ""
  RPN_InfixToRpn(*this,expr)
  len = Len(*this\rpn)
  ct = CountString(*this\rpn," ")
  For a = 1 To ct+1
    token = StringField(*this\rpn,a," ")
    If *this\tokens(token)
      RPN_EvalOperator(*this,token) 
    ElseIf token <> ":"  And token <> "?" 
      AddElement(*this\stack())
      *this\stack() = token
      *this\StackCounter+1
    EndIf   
  Next   
  
  result.s = *this\stack()
  DeleteElement(*this\stack())
  
  ProcedureReturn result
  
EndProcedure   

DataSection: VT_RPN: 
  Data.i @RPN_Eval()
  Data.i @RPN_IsNumeric() 
  Data.i @RPN_Free() 
EndDataSection   

; ****

CompilerIf #PB_Compiler_IsMainFile 
  
Define *rpn.IRPN = NewRPN() 
;examples ************************************************************************************* 
Debug *rpn\Eval("6*(3-2)") ;6
Debug *rpn\Eval("-5+-3"); -8
Debug *rpn\eval("(varA=Hello varB=World c=2) 6>>1 > c ? (varA+varB) : (varB+varA)"); "HelloWorld"
Debug *rpn\eval("(varA=Hello varB=World c=4) 6>>1 > c ? (varA+varB) : (varB+varA)"); "WorldHello"
Debug *rpn\eval("(a=5  b=4) (a*b*2)") ;40    
Debug *rpn\eval("(a=5  b=4) c= (a*b*2) : c > 39 ? true : false"); True
Debug *rpn\eval("(a=5 b=4) cc= (a*b*2) cc + cc < (a*b) ? true : cc"); 80
Debug *rpn\eval("1+-3"); -2
Debug *rpn\eval("5+((1+2)*4)-3"); 14
Debug *rpn\eval("5.12+sin(-13)"); 4.6998
Debug 5.12+Sin(-13); 4.6998 

*rpn\Free() 
*rpn.IRPN = NewRPN()

;Example basic Calculator  
Global strinput.s,memory.s,ev,evg,evt
;{
Enumeration 
  #output
  #BBack
  #BCE
  #BC
  #BL
  #BR
  #BMC
  #B7
  #B8
  #B9
  #BDIV
  #Bsqrt
  #BMR
  #B4
  #B5
  #B6
  #BMUL
  #BPer
  #BMS
  #B1
  #B2
  #B3
  #BMIN
  #B1X
  #BMP
  #B0
  #BPM
  #BDOT
  #BPLUS
  #BEQ 
EndEnumeration
;} 
OpenWindow(0,0,0,240,230,"calc")
StringGadget(#Output,0,0,240,30,"")
;{-
ButtonGadget(#BBack,0,30,40,40,"<-")
ButtonGadget(#BCE,40,30,40,40,"CE")
ButtonGadget(#BC,80,30,40,40,"C")
ButtonGadget(#BL,120,30,40,40,"(")
ButtonGadget(#BR,160,30,40,40,")")

;}-
;{-
ButtonGadget(#BMC,0,70,40,40,"MC")
ButtonGadget(#B7,40,70,40,40,"7")
ButtonGadget(#B8,80,70,40,40,"8")
ButtonGadget(#B9,120,70,40,40,"9")
ButtonGadget(#Bdiv,160,70,40,40,Chr(247))
ButtonGadget(#Bsqrt,200,70,40,40,"sqr")
;}
;{
ButtonGadget(#BMR,0,110,40,40,"MR")
ButtonGadget(#B4,40,110,40,40,"4")
ButtonGadget(#B5,80,110,40,40,"5")
ButtonGadget(#B6,120,110,40,40,"6")
ButtonGadget(#BMUL,160,110,40,40,"x")
ButtonGadget(#BPer,200,110,40,40,"%")
;}
;{
ButtonGadget(#BMS,0,150,40,40,"MS")
ButtonGadget(#B1,40,150,40,40,"1")
ButtonGadget(#B2,80,150,40,40,"2")
ButtonGadget(#B3,120,150,40,40,"3")
ButtonGadget(#BMIN,160,150,40,40,"-")
ButtonGadget(#B1X,200,150,40,40,"1/x")
;}
;{
ButtonGadget(#BMP,0,190,40,40,"M+")
ButtonGadget(#B0,40,190,40,40,"0")
ButtonGadget(#BPM,80,190,40,40,Chr(177))
ButtonGadget(#BDOT,120,190,40,40,".")
ButtonGadget(#BPLUS,160,190,40,40,"+")
ButtonGadget(#BEQ,200,190,40,40,"=")
;}

Repeat 
  
  ev=WaitWindowEvent()
  If ev <> 0 
    evg = EventGadget() 
    evt = EventType()
    
    If evt = #PB_EventType_LeftClick       
      
      Select evg 
        Case #B0 
          strinput + "0"
        Case #B1 
          strinput + "1"
        Case #B2 
          strinput + "2"
        Case #B3 
          strinput + "3"
        Case #B4
          strinput + "4"
        Case #B5
          strinput + "5"
        Case #B6
          strinput + "6"
        Case #B7 
          strinput + "7"
        Case #B8
          strinput + "8"
        Case #B9 
          strinput + "9"
        Case #BPLUS
          strinput + "+"
        Case #BMIN 
          strinput + "-"
        Case #BMul
          strinput + "*"
        Case #BDIV 
          strinput + "/"
        Case #BDOT
          strinput +"."
        Case #B1X 
          strinput = "1/(" + strinput + ")"
        Case #Bsqrt
          strinput + "sqrt" 
        Case #BL  
          strinput + "("
        Case #BR
          strinput + ")"
        Case #BPer 
          Define ct,strval.s,sop.s
          ct=Len(strinput)
          While *rpn\IsNumeric(Mid(strinput,ct,1)) And ct > 0
            ct-1
          Wend  
          strval = Right(strinput,Len(strinput)-ct)
          sop = Mid(strinput,ct,1)
          strinput = Left(strinput,ct)
          If sop <> "*" And sop <> "/" 
            strinput + "(" + strval + "*(" + strval + "/100))"
          Else 
            strinput + "(" + strval + "/100)"  
          EndIf   
          strinput = *rpn\eval(strinput)  
        Case #BPM 
          strinput = "-(" + strinput + ")"
        Case #BC
          strinput = ""
        Case #BCE 
          strinput =""
          memory = ""
        Case #BMS
          memory = strinput 
        Case #BMP
          memory = *rpn\eval(strinput + "+" + memory) 
        Case #BMR 
          strinput + memory
        Case #BMC
          memory = ""
        Case #BEQ 
          If strinput =""
            strinput = GetGadgetText(#output)
          EndIf 
          If strinput <> ""
            strinput = *rpn\eval(strinput)
          EndIf   
      EndSelect 
      If evg
        SetGadgetText(#output,strinput)
      EndIf
    EndIf 
  EndIf 
Until ev = #PB_Event_CloseWindow 

CompilerEndIf
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6499
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Evaluate Function For Math Library

Post by mk-soft »

I adjusted it because of the stricter rules of PureBasic

Code: Select all

; Author: IDLE
; Date: 11,10,2019
; PB version: v5.62 windows 
; Version 0.53
; Updated for PB 5.62 
; added fix for unary negation 
; Date: 26,4, 2011
; PB version: v4.51 linux

; Version 0.52  
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; RPN interpretor (Reverse Polish Notation) 
; parse infix to RPN and calculates results 
; http://en.wikipedia.org/wiki/Reverse_Polish_notation 
; supported operators
; + - * / "% ^ << >>
; ~ ! | &  bitwise 
; > < >= <= <> ==  ternary operators  eg a > b ? x : y  or  a > b : x : y  or a > b x y   
; sin cos tan sqrt
; variables numeric and strings 
EnableExplicit 

Enumeration 10
  #RPN_IsNumeric
  #RPN_IsAlpha
  #RPN_IsSymbol 
  #RPN_IsOther 
EndEnumeration

Structure RPN_Variables     
  len.i
  type.i
  num.d
  str.s
EndStructure

Structure RPN_Class
  *vt
  StackCounter.i
  rpn.s
  Map tokens.i()
  Map var.RPN_Variables()
  List stack.s()
EndStructure   

Interface IRPN 
  Eval.s(expr.s) 
  IsNumeric(expr.s) 
  Free() 
EndInterface   

Procedure NewRPN() 
  Protected *this.RPN_Class 
  *this = AllocateStructure(RPN_Class) 
  If *this 
    *this\tokens("(") =1
    *this\tokens("+") =4
    *this\tokens("-")=4
    *this\tokens("_")=8
    *this\tokens("*")=5
    *this\tokens("/")=5
    *this\tokens("%")=7
    *this\tokens("^")=5
    *this\tokens(">>")=7
    *this\tokens("<<")=7
    *this\tokens("!")=6
    *this\tokens("&")=6
    *this\tokens("|")=6
    *this\tokens("~")=8
    *this\tokens("=")=8
    *this\tokens(">")=4
    *this\tokens("<")=4
    *this\tokens(">=")=4
    *this\tokens("<=")=4
    *this\tokens("<>")=4
    *this\tokens("==")=4 
    *this\tokens(")")=1
    *this\tokens("sin")=5
    *this\tokens("cos")=5
    *this\tokens("tan")=5
    *this\tokens("?")=0
    *this\tokens(":")=0
    *this\tokens("sqrt")=5
    *this\vt = ?VT_RPN 
    ProcedureReturn *this 
  EndIf   

EndProcedure  

Procedure RPN_Free(*this)
  ClearStructure(*this,RPN_Class) 
  FreeStructure(*this) 
EndProcedure 

Procedure RPN_IsNumeric(*this,strin.s) 
  Protected char.i
  If strin <> ""
  char = PeekC(@strin)
  If char = 45 Or (char >=48 And char <=57) 
    ProcedureReturn 1
  Else  
    ProcedureReturn 0
  EndIf      
  EndIf 
EndProcedure

Procedure RPN_NewVar(*this.RPN_Class,v.s,val.s)
  Protected *v
  
  If RPN_IsNumeric(*this,val)  
    *this\var(v)\num = ValD(val) 
    *this\var(v)\len = SizeOf(Double)
    *this\var(v)\type = #RPN_IsNumeric
  Else 
    *this\var(v)\str = val 
    *this\var(v)\type = #RPN_IsAlpha
    *this\var(v)\len = Len(val) 
  EndIf   
  
EndProcedure 

Procedure RPN_SetVar(*this.RPN_Class,v.s,val.s)
  Protected *v,va.s,type.s
  
  If Not *this\var(v)\len
    RPN_NewVar(*this,v,val)
  Else 
    If *this\var(v)\type = #RPN_IsNumeric  
      *this\var(v)\num = ValD(val)
    Else 
      *this\var(v)\str = val 
      *this\var(v)\len = Len(val) 
    EndIf    
    
  EndIf   
EndProcedure 

Procedure RPN_Push(*this.RPN_Class,token.s)
  Static ct,top.s
  If token = "("
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  ElseIf *this\StackCounter = 0   
    AddElement(*this\stack())
    *this\stack()= token
    *this\StackCounter+1
  Else
    top = *this\stack()
    While *this\tokens(top) > *this\tokens(token) And *this\StackCounter > 0
      *this\rpn + *this\stack() + " "
      DeleteElement(*this\stack())
      *this\StackCounter-1
    Wend
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  EndIf
  
EndProcedure

Procedure RPN_Pop(*this.RPN_Class,cond.s)
  Protected token.s
  While *this\StackCounter > 0
    token = *this\stack()
    If token = cond
      DeleteElement(*this\stack())
      *this\StackCounter-1
      Break
    Else
      *this\rpn + token + " "
    EndIf
    DeleteElement(*this\stack())
    *this\StackCounter-1
  Wend
EndProcedure

Procedure RPN_InfixToRpn(*this.RPN_Class,expr.s)
  Protected len,a,b,c,char,state,token.s,Tstate,lstate,ltoken.s 
  
  len = StringByteLength(expr)
  
  While a < len 
    b=a
    token=""
    While b < len
      char = PeekC(@expr+b)
      If (char = '.' And state = #RPN_IsNumeric) Or (char >='0' And char <='9') 
        state = #RPN_IsNumeric
      ElseIf (char = '.' And state = #RPN_IsAlpha) Or (char >='A' And char <='Z')  
        state = #RPN_IsAlpha 
      ElseIf char >='a' And char <='z'
        state = #RPN_IsAlpha 
      ElseIf char <> ' '  
        state = #RPN_IsSymbol
      Else 
        state = #RPN_IsOther
      EndIf 
      If Not Tstate 
        Tstate = state 
      EndIf   
      If Tstate <> state 
        Break
      Else 
        token + Chr(char)
        If (char >= '(') And (char <='+') Or char = '-' Or char = '/' Or char = '=' Or char ='!' Or char = '^' Or char = '_' Or char = '~'
          b+SizeOf(Character)
          Break 
        EndIf    
      EndIf   
      b+SizeOf(Character)
    Wend       
    a=b      
    
    If Tstate = #RPN_IsSymbol
      If token = ")"
        RPN_Pop(*this,"(")
      ElseIf *this\tokens(token)
        If ((lstate = #RPN_IsSymbol Or lstate =0) And token = "-")  
          If (ltoken <> ")" And Not RPN_IsNumeric(*this,ltoken))
            token = "_"
          EndIf   
        EndIf   
        RPN_Push(*this,token)
      EndIf   
    ElseIf tstate = #RPN_IsAlpha
      If *this\tokens(token)
        RPN_Push(*this,token)
      Else 
        *this\Rpn + token + " "   
      EndIf    
    ElseIf tState = #RPN_IsNumeric 
      *this\Rpn + token + " "   
    EndIf   
    Tstate = state
    lstate = state  
    ltoken = token
  Wend   
  RPN_Pop(*this,"end")
  *this\rpn = Trim(*this\rpn)
  
EndProcedure

Macro _RPN_Pop(op,v)
  If ListSize(*this\stack()) > 0
    op = *this\stack()
    If *this\var(op)\type > 0
      *v = @*this\var(op)
      vr\type = #RPN_IsNumeric 
    Else   
      If RPN_IsNumeric(*this,op)
        *v = @t#v
        *v\num = ValD(op)
        *v\str = ""
        *v\type = #RPN_IsNumeric 
        vr\type =#RPN_IsNumeric 
      Else  
        *v = @t#v
        *v\num = 0
        *v\str = op
        *v\type = #RPN_IsAlpha
        vr\type =#RPN_IsAlpha
      EndIf  
    EndIf   
    DeleteElement(*this\stack())
  EndIf   
EndMacro

Macro _RPN_Assign(cond)
  If cond
    If *v2\type = #RPN_IsNumeric 
      vr\num = *v2\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str
    EndIf   
  Else
    If *v1\type = #RPN_IsNumeric
      vr\num = *v1\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v1\str
    EndIf
  EndIf    
EndMacro 

Procedure RPN_EvalOperator(*this.RPN_Class,operator.s)
  Protected op1.s,op2.s,op3.s,op4.s,result.s
  Protected t1.q,tq.q,rq.q,t2
  Protected *v1.RPN_Variables,*v2.RPN_Variables,*v3.RPN_Variables,*v4.RPN_Variables 
  Protected tv1.RPN_Variables,tv2.RPN_Variables,tv3.RPN_Variables,tv4.RPN_Variables
  Protected vr.RPN_Variables 
  _RPN_Pop(op1,v1)
  If operator <> "~" And operator <> "sin" And operator <> "cos" And operator <> "tan" And  operator <> "sqrt" And operator <> "_"
    _RPN_Pop(op2,v2)
    If op2 <> ""
      *this\StackCounter-2
    Else 
      *this\StackCounter-1
    EndIf   
  Else
    *this\StackCounter-1
  EndIf
  If operator = "+"
    If *v1\type = #RPN_IsNumeric And  *v2\type = #RPN_IsNumeric
      vr\num = *v2\num + *v1\num 
      vr\type = #RPN_IsNumeric
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str + *v1\str 
    EndIf   
  ElseIf  operator = "-"
    If op2 <> ""
      vr\num = *v2\num - *v1\num
    Else 
      vr\num = -*v1\num  
    EndIf  
  ElseIf operator = "*"
    vr\num = *v2\num * *v1\num
  ElseIf operator = "/"
    If *v1\num <> 0
      vr\num = *v2\num / *v1\num
    EndIf   
  ElseIf operator = "%"
    vr\num =Mod(*v2\num,*v1\num)
  ElseIf operator = "^"
    vr\num = Pow(*v2\num,*v1\num)
  ElseIf operator =">"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num > *v3\num)
  ElseIf operator ="<"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num < *v3\num)
  ElseIf operator =">="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num >= *v3\num)
  ElseIf operator ="<="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num <= *v3\num)
  ElseIf operator ="<>"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num <> *v3\num)
    Else
      _RPN_Assign(*v4\str <> *v3\str)
    EndIf 
  ElseIf operator ="=="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num = *v3\num)
    Else
      _RPN_Assign(*v4\str = *v3\str)
    EndIf 
  ElseIf operator =">>"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 >> t1
    vr\num = rq
  ElseIf operator ="<<"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 << t1
    vr\num = rq
  ElseIf operator ="!"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 ! t1
    vr\num = rq
  ElseIf operator ="&"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 & t1
    vr\num = rq
  ElseIf operator ="|"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 | t1
    vr\num = rq   
  ElseIf operator ="~"
    t1 = *v1\num
    rq = ~t1
    vr\num = rq
  ElseIf operator ="_"
    t1 = *v1\num
    rq = -t1
    vr\num = rq  
  ElseIf operator ="sin"
    vr\num = Sin(*v1\num)
  ElseIf operator ="cos"
    vr\num = Cos(*v1\num)
  ElseIf operator ="tan"
    vr\num = Tan(*v1\num)
  ElseIf  operator = "sqrt"
    vr\num = Sqr(*v1\num)
  EndIf   
  If operator = "="
    If *v2 And *v2\type = #RPN_IsNumeric  
      RPN_SetVar(*this,op1,op2)
    Else
      RPN_SetVar(*this,op2,op1)
    EndIf   
  Else
    If vr\type = #RPN_IsNumeric
      result = StrD(vr\num)
    Else 
      result = vr\str
    EndIf   
    AddElement(*this\stack())
    *this\stack() = result
    *this\StackCounter+1
  EndIf
EndProcedure

Procedure.s RPN_Eval(*this.RPN_Class,expr.s)
  Protected token.s,len,ct,a,result.s
  
  ClearList(*this\stack())
  ClearMap(*this\var())
  *this\StackCounter=0
  *this\rpn = ""
  RPN_InfixToRpn(*this,expr)
  len = Len(*this\rpn)
  ct = CountString(*this\rpn," ")
  For a = 1 To ct+1
    token = StringField(*this\rpn,a," ")
    If *this\tokens(token)
      RPN_EvalOperator(*this,token) 
    ElseIf token <> ":"  And token <> "?" 
      AddElement(*this\stack())
      *this\stack() = token
      *this\StackCounter+1
    EndIf   
  Next   
  
  result.s = *this\stack()
  DeleteElement(*this\stack())
  
  ProcedureReturn result
  
EndProcedure   

DataSection: VT_RPN: 
  Data.i @RPN_Eval()
  Data.i @RPN_IsNumeric() 
  Data.i @RPN_Free() 
EndDataSection   

; ****

CompilerIf #PB_Compiler_IsMainFile 
  
Define *rpn.IRPN = NewRPN() 
;examples ************************************************************************************* 
Debug *rpn\Eval("6*(3-2)") ;6
Debug *rpn\Eval("-5+-3"); -8
Debug *rpn\eval("(varA=Hello varB=World c=2) 6>>1 > c ? (varA+varB) : (varB+varA)"); "HelloWorld"
Debug *rpn\eval("(varA=Hello varB=World c=4) 6>>1 > c ? (varA+varB) : (varB+varA)"); "WorldHello"
Debug *rpn\eval("(a=5  b=4) (a*b*2)") ;40    
Debug *rpn\eval("(a=5  b=4) c= (a*b*2) : c > 39 ? true : false"); True
Debug *rpn\eval("(a=5 b=4) cc= (a*b*2) cc + cc < (a*b) ? true : cc"); 80
Debug *rpn\eval("1+-3"); -2
Debug *rpn\eval("5+((1+2)*4)-3"); 14
Debug *rpn\eval("5.12+sin(-13)"); 4.6998
Debug 5.12+Sin(-13); 4.6998 

*rpn\Free() 
*rpn.IRPN = NewRPN()

;Example basic Calculator  
Global strinput.s,memory.s,ev,evg,evt
;{
Enumeration 
  #output
  #BBack
  #BCE
  #BC
  #BL
  #BR
  #BMC
  #B7
  #B8
  #B9
  #BDIV
  #Bsqrt
  #BMR
  #B4
  #B5
  #B6
  #BMUL
  #BPer
  #BMS
  #B1
  #B2
  #B3
  #BMIN
  #B1X
  #BMP
  #B0
  #BPM
  #BDOT
  #BPLUS
  #BEQ 
EndEnumeration
;} 
OpenWindow(0,0,0,240,230,"calc")
StringGadget(#Output,0,0,240,30,"")
;{-
ButtonGadget(#BBack,0,30,40,40,"<-")
ButtonGadget(#BCE,40,30,40,40,"CE")
ButtonGadget(#BC,80,30,40,40,"C")
ButtonGadget(#BL,120,30,40,40,"(")
ButtonGadget(#BR,160,30,40,40,")")

;}-
;{-
ButtonGadget(#BMC,0,70,40,40,"MC")
ButtonGadget(#B7,40,70,40,40,"7")
ButtonGadget(#B8,80,70,40,40,"8")
ButtonGadget(#B9,120,70,40,40,"9")
ButtonGadget(#Bdiv,160,70,40,40,Chr(247))
ButtonGadget(#Bsqrt,200,70,40,40,"sqr")
;}
;{
ButtonGadget(#BMR,0,110,40,40,"MR")
ButtonGadget(#B4,40,110,40,40,"4")
ButtonGadget(#B5,80,110,40,40,"5")
ButtonGadget(#B6,120,110,40,40,"6")
ButtonGadget(#BMUL,160,110,40,40,"x")
ButtonGadget(#BPer,200,110,40,40,"%")
;}
;{
ButtonGadget(#BMS,0,150,40,40,"MS")
ButtonGadget(#B1,40,150,40,40,"1")
ButtonGadget(#B2,80,150,40,40,"2")
ButtonGadget(#B3,120,150,40,40,"3")
ButtonGadget(#BMIN,160,150,40,40,"-")
ButtonGadget(#B1X,200,150,40,40,"1/x")
;}
;{
ButtonGadget(#BMP,0,190,40,40,"M+")
ButtonGadget(#B0,40,190,40,40,"0")
ButtonGadget(#BPM,80,190,40,40,Chr(177))
ButtonGadget(#BDOT,120,190,40,40,".")
ButtonGadget(#BPLUS,160,190,40,40,"+")
ButtonGadget(#BEQ,200,190,40,40,"=")
;}

Repeat 
  
  ev=WaitWindowEvent()
  If ev <> 0 
    evg = EventGadget() 
    evt = EventType()
    
    If evt = #PB_EventType_LeftClick       
      
      Select evg 
        Case #B0 
          strinput + "0"
        Case #B1 
          strinput + "1"
        Case #B2 
          strinput + "2"
        Case #B3 
          strinput + "3"
        Case #B4
          strinput + "4"
        Case #B5
          strinput + "5"
        Case #B6
          strinput + "6"
        Case #B7 
          strinput + "7"
        Case #B8
          strinput + "8"
        Case #B9 
          strinput + "9"
        Case #BPLUS
          strinput + "+"
        Case #BMIN 
          strinput + "-"
        Case #BMul
          strinput + "*"
        Case #BDIV 
          strinput + "/"
        Case #BDOT
          strinput +"."
        Case #B1X 
          strinput = "1/(" + strinput + ")"
        Case #Bsqrt
          strinput + "sqrt" 
        Case #BL  
          strinput + "("
        Case #BR
          strinput + ")"
        Case #BPer 
          Define ct,strval.s,sop.s
          ct=Len(strinput)
          While *rpn\IsNumeric(Mid(strinput,ct,1)) And ct > 0
            ct-1
          Wend  
          strval = Right(strinput,Len(strinput)-ct)
          sop = Mid(strinput,ct,1)
          strinput = Left(strinput,ct)
          If sop <> "*" And sop <> "/" 
            strinput + "(" + strval + "*(" + strval + "/100))"
          Else 
            strinput + "(" + strval + "/100)"  
          EndIf   
          strinput = *rpn\eval(strinput)  
        Case #BPM 
          strinput = "-(" + strinput + ")"
        Case #BC
          strinput = ""
        Case #BCE 
          strinput =""
          memory = ""
        Case #BMS
          memory = strinput 
        Case #BMP
          memory = *rpn\eval(strinput + "+" + memory) 
        Case #BMR 
          strinput + memory
        Case #BMC
          memory = ""
        Case #BEQ 
          If strinput =""
            strinput = GetGadgetText(#output)
          EndIf 
          If strinput <> ""
            strinput = *rpn\eval(strinput)
          EndIf   
      EndSelect 
      If evg
        SetGadgetText(#output,strinput)
      EndIf
    EndIf 
  EndIf 
Until ev = #PB_Event_CloseWindow 

CompilerEndIf
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
idle
Always Here
Always Here
Posts: 6154
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Evaluate Function For Math Library

Post by idle »

mk-soft wrote: Fri Jan 16, 2026 10:43 pm I adjusted it because of the stricter rules of PureBasic

Code: Select all

; Author: IDLE
; Date: 11,10,2019
; PB version: v5.62 windows 
; Version 0.53
; Updated for PB 5.62 
; added fix for unary negation 
; Date: 26,4, 2011
; PB version: v4.51 linux

; Version 0.52  
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; RPN interpretor (Reverse Polish Notation) 
; parse infix to RPN and calculates results 
; http://en.wikipedia.org/wiki/Reverse_Polish_notation 
; supported operators
; + - * / "% ^ << >>
; ~ ! | &  bitwise 
; > < >= <= <> ==  ternary operators  eg a > b ? x : y  or  a > b : x : y  or a > b x y   
; sin cos tan sqrt
; variables numeric and strings 
EnableExplicit 

Enumeration 10
  #RPN_IsNumeric
  #RPN_IsAlpha
  #RPN_IsSymbol 
  #RPN_IsOther 
EndEnumeration

Structure RPN_Variables     
  len.i
  type.i
  num.d
  str.s
EndStructure

Structure RPN_Class
  *vt
  StackCounter.i
  rpn.s
  Map tokens.i()
  Map var.RPN_Variables()
  List stack.s()
EndStructure   

Interface IRPN 
  Eval.s(expr.s) 
  IsNumeric(expr.s) 
  Free() 
EndInterface   

Procedure NewRPN() 
  Protected *this.RPN_Class 
  *this = AllocateStructure(RPN_Class) 
  If *this 
    *this\tokens("(") =1
    *this\tokens("+") =4
    *this\tokens("-")=4
    *this\tokens("_")=8
    *this\tokens("*")=5
    *this\tokens("/")=5
    *this\tokens("%")=7
    *this\tokens("^")=5
    *this\tokens(">>")=7
    *this\tokens("<<")=7
    *this\tokens("!")=6
    *this\tokens("&")=6
    *this\tokens("|")=6
    *this\tokens("~")=8
    *this\tokens("=")=8
    *this\tokens(">")=4
    *this\tokens("<")=4
    *this\tokens(">=")=4
    *this\tokens("<=")=4
    *this\tokens("<>")=4
    *this\tokens("==")=4 
    *this\tokens(")")=1
    *this\tokens("sin")=5
    *this\tokens("cos")=5
    *this\tokens("tan")=5
    *this\tokens("?")=0
    *this\tokens(":")=0
    *this\tokens("sqrt")=5
    *this\vt = ?VT_RPN 
    ProcedureReturn *this 
  EndIf   

EndProcedure  

Procedure RPN_Free(*this)
  ClearStructure(*this,RPN_Class) 
  FreeStructure(*this) 
EndProcedure 

Procedure RPN_IsNumeric(*this,strin.s) 
  Protected char.i
  If strin <> ""
  char = PeekC(@strin)
  If char = 45 Or (char >=48 And char <=57) 
    ProcedureReturn 1
  Else  
    ProcedureReturn 0
  EndIf      
  EndIf 
EndProcedure

Procedure RPN_NewVar(*this.RPN_Class,v.s,val.s)
  Protected *v
  
  If RPN_IsNumeric(*this,val)  
    *this\var(v)\num = ValD(val) 
    *this\var(v)\len = SizeOf(Double)
    *this\var(v)\type = #RPN_IsNumeric
  Else 
    *this\var(v)\str = val 
    *this\var(v)\type = #RPN_IsAlpha
    *this\var(v)\len = Len(val) 
  EndIf   
  
EndProcedure 

Procedure RPN_SetVar(*this.RPN_Class,v.s,val.s)
  Protected *v,va.s,type.s
  
  If Not *this\var(v)\len
    RPN_NewVar(*this,v,val)
  Else 
    If *this\var(v)\type = #RPN_IsNumeric  
      *this\var(v)\num = ValD(val)
    Else 
      *this\var(v)\str = val 
      *this\var(v)\len = Len(val) 
    EndIf    
    
  EndIf   
EndProcedure 

Procedure RPN_Push(*this.RPN_Class,token.s)
  Static ct,top.s
  If token = "("
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  ElseIf *this\StackCounter = 0   
    AddElement(*this\stack())
    *this\stack()= token
    *this\StackCounter+1
  Else
    top = *this\stack()
    While *this\tokens(top) > *this\tokens(token) And *this\StackCounter > 0
      *this\rpn + *this\stack() + " "
      DeleteElement(*this\stack())
      *this\StackCounter-1
    Wend
    AddElement(*this\stack())
    *this\stack() = token
    *this\StackCounter+1
  EndIf
  
EndProcedure

Procedure RPN_Pop(*this.RPN_Class,cond.s)
  Protected token.s
  While *this\StackCounter > 0
    token = *this\stack()
    If token = cond
      DeleteElement(*this\stack())
      *this\StackCounter-1
      Break
    Else
      *this\rpn + token + " "
    EndIf
    DeleteElement(*this\stack())
    *this\StackCounter-1
  Wend
EndProcedure

Procedure RPN_InfixToRpn(*this.RPN_Class,expr.s)
  Protected len,a,b,c,char,state,token.s,Tstate,lstate,ltoken.s 
  
  len = StringByteLength(expr)
  
  While a < len 
    b=a
    token=""
    While b < len
      char = PeekC(@expr+b)
      If (char = '.' And state = #RPN_IsNumeric) Or (char >='0' And char <='9') 
        state = #RPN_IsNumeric
      ElseIf (char = '.' And state = #RPN_IsAlpha) Or (char >='A' And char <='Z')  
        state = #RPN_IsAlpha 
      ElseIf char >='a' And char <='z'
        state = #RPN_IsAlpha 
      ElseIf char <> ' '  
        state = #RPN_IsSymbol
      Else 
        state = #RPN_IsOther
      EndIf 
      If Not Tstate 
        Tstate = state 
      EndIf   
      If Tstate <> state 
        Break
      Else 
        token + Chr(char)
        If (char >= '(') And (char <='+') Or char = '-' Or char = '/' Or char = '=' Or char ='!' Or char = '^' Or char = '_' Or char = '~'
          b+SizeOf(Character)
          Break 
        EndIf    
      EndIf   
      b+SizeOf(Character)
    Wend       
    a=b      
    
    If Tstate = #RPN_IsSymbol
      If token = ")"
        RPN_Pop(*this,"(")
      ElseIf *this\tokens(token)
        If ((lstate = #RPN_IsSymbol Or lstate =0) And token = "-")  
          If (ltoken <> ")" And Not RPN_IsNumeric(*this,ltoken))
            token = "_"
          EndIf   
        EndIf   
        RPN_Push(*this,token)
      EndIf   
    ElseIf tstate = #RPN_IsAlpha
      If *this\tokens(token)
        RPN_Push(*this,token)
      Else 
        *this\Rpn + token + " "   
      EndIf    
    ElseIf tState = #RPN_IsNumeric 
      *this\Rpn + token + " "   
    EndIf   
    Tstate = state
    lstate = state  
    ltoken = token
  Wend   
  RPN_Pop(*this,"end")
  *this\rpn = Trim(*this\rpn)
  
EndProcedure

Macro _RPN_Pop(op,v)
  If ListSize(*this\stack()) > 0
    op = *this\stack()
    If *this\var(op)\type > 0
      *v = @*this\var(op)
      vr\type = #RPN_IsNumeric 
    Else   
      If RPN_IsNumeric(*this,op)
        *v = @t#v
        *v\num = ValD(op)
        *v\str = ""
        *v\type = #RPN_IsNumeric 
        vr\type =#RPN_IsNumeric 
      Else  
        *v = @t#v
        *v\num = 0
        *v\str = op
        *v\type = #RPN_IsAlpha
        vr\type =#RPN_IsAlpha
      EndIf  
    EndIf   
    DeleteElement(*this\stack())
  EndIf   
EndMacro

Macro _RPN_Assign(cond)
  If cond
    If *v2\type = #RPN_IsNumeric 
      vr\num = *v2\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str
    EndIf   
  Else
    If *v1\type = #RPN_IsNumeric
      vr\num = *v1\num
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v1\str
    EndIf
  EndIf    
EndMacro 

Procedure RPN_EvalOperator(*this.RPN_Class,operator.s)
  Protected op1.s,op2.s,op3.s,op4.s,result.s
  Protected t1.q,tq.q,rq.q,t2
  Protected *v1.RPN_Variables,*v2.RPN_Variables,*v3.RPN_Variables,*v4.RPN_Variables 
  Protected tv1.RPN_Variables,tv2.RPN_Variables,tv3.RPN_Variables,tv4.RPN_Variables
  Protected vr.RPN_Variables 
  _RPN_Pop(op1,v1)
  If operator <> "~" And operator <> "sin" And operator <> "cos" And operator <> "tan" And  operator <> "sqrt" And operator <> "_"
    _RPN_Pop(op2,v2)
    If op2 <> ""
      *this\StackCounter-2
    Else 
      *this\StackCounter-1
    EndIf   
  Else
    *this\StackCounter-1
  EndIf
  If operator = "+"
    If *v1\type = #RPN_IsNumeric And  *v2\type = #RPN_IsNumeric
      vr\num = *v2\num + *v1\num 
      vr\type = #RPN_IsNumeric
    Else 
      vr\type = #RPN_IsAlpha
      vr\str = *v2\str + *v1\str 
    EndIf   
  ElseIf  operator = "-"
    If op2 <> ""
      vr\num = *v2\num - *v1\num
    Else 
      vr\num = -*v1\num  
    EndIf  
  ElseIf operator = "*"
    vr\num = *v2\num * *v1\num
  ElseIf operator = "/"
    If *v1\num <> 0
      vr\num = *v2\num / *v1\num
    EndIf   
  ElseIf operator = "%"
    vr\num =Mod(*v2\num,*v1\num)
  ElseIf operator = "^"
    vr\num = Pow(*v2\num,*v1\num)
  ElseIf operator =">"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num > *v3\num)
  ElseIf operator ="<"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num < *v3\num)
  ElseIf operator =">="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num >= *v3\num)
  ElseIf operator ="<="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    _RPN_Assign(*v4\num <= *v3\num)
  ElseIf operator ="<>"
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num <> *v3\num)
    Else
      _RPN_Assign(*v4\str <> *v3\str)
    EndIf 
  ElseIf operator ="=="
    _RPN_Pop(op3,v3)
    _RPN_Pop(op4,v4)
    *this\StackCounter-2
    If *v4\type = #RPN_IsNumeric
      _RPN_Assign(*v4\num = *v3\num)
    Else
      _RPN_Assign(*v4\str = *v3\str)
    EndIf 
  ElseIf operator =">>"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 >> t1
    vr\num = rq
  ElseIf operator ="<<"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 << t1
    vr\num = rq
  ElseIf operator ="!"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 ! t1
    vr\num = rq
  ElseIf operator ="&"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 & t1
    vr\num = rq
  ElseIf operator ="|"
    t2 = *v2\num
    t1 = *v1\num
    rq = t2 | t1
    vr\num = rq   
  ElseIf operator ="~"
    t1 = *v1\num
    rq = ~t1
    vr\num = rq
  ElseIf operator ="_"
    t1 = *v1\num
    rq = -t1
    vr\num = rq  
  ElseIf operator ="sin"
    vr\num = Sin(*v1\num)
  ElseIf operator ="cos"
    vr\num = Cos(*v1\num)
  ElseIf operator ="tan"
    vr\num = Tan(*v1\num)
  ElseIf  operator = "sqrt"
    vr\num = Sqr(*v1\num)
  EndIf   
  If operator = "="
    If *v2 And *v2\type = #RPN_IsNumeric  
      RPN_SetVar(*this,op1,op2)
    Else
      RPN_SetVar(*this,op2,op1)
    EndIf   
  Else
    If vr\type = #RPN_IsNumeric
      result = StrD(vr\num)
    Else 
      result = vr\str
    EndIf   
    AddElement(*this\stack())
    *this\stack() = result
    *this\StackCounter+1
  EndIf
EndProcedure

Procedure.s RPN_Eval(*this.RPN_Class,expr.s)
  Protected token.s,len,ct,a,result.s
  
  ClearList(*this\stack())
  ClearMap(*this\var())
  *this\StackCounter=0
  *this\rpn = ""
  RPN_InfixToRpn(*this,expr)
  len = Len(*this\rpn)
  ct = CountString(*this\rpn," ")
  For a = 1 To ct+1
    token = StringField(*this\rpn,a," ")
    If *this\tokens(token)
      RPN_EvalOperator(*this,token) 
    ElseIf token <> ":"  And token <> "?" 
      AddElement(*this\stack())
      *this\stack() = token
      *this\StackCounter+1
    EndIf   
  Next   
  
  result.s = *this\stack()
  DeleteElement(*this\stack())
  
  ProcedureReturn result
  
EndProcedure   

DataSection: VT_RPN: 
  Data.i @RPN_Eval()
  Data.i @RPN_IsNumeric() 
  Data.i @RPN_Free() 
EndDataSection   

; ****

CompilerIf #PB_Compiler_IsMainFile 
  
Define *rpn.IRPN = NewRPN() 
;examples ************************************************************************************* 
Debug *rpn\Eval("6*(3-2)") ;6
Debug *rpn\Eval("-5+-3"); -8
Debug *rpn\eval("(varA=Hello varB=World c=2) 6>>1 > c ? (varA+varB) : (varB+varA)"); "HelloWorld"
Debug *rpn\eval("(varA=Hello varB=World c=4) 6>>1 > c ? (varA+varB) : (varB+varA)"); "WorldHello"
Debug *rpn\eval("(a=5  b=4) (a*b*2)") ;40    
Debug *rpn\eval("(a=5  b=4) c= (a*b*2) : c > 39 ? true : false"); True
Debug *rpn\eval("(a=5 b=4) cc= (a*b*2) cc + cc < (a*b) ? true : cc"); 80
Debug *rpn\eval("1+-3"); -2
Debug *rpn\eval("5+((1+2)*4)-3"); 14
Debug *rpn\eval("5.12+sin(-13)"); 4.6998
Debug 5.12+Sin(-13); 4.6998 

*rpn\Free() 
*rpn.IRPN = NewRPN()

;Example basic Calculator  
Global strinput.s,memory.s,ev,evg,evt
;{
Enumeration 
  #output
  #BBack
  #BCE
  #BC
  #BL
  #BR
  #BMC
  #B7
  #B8
  #B9
  #BDIV
  #Bsqrt
  #BMR
  #B4
  #B5
  #B6
  #BMUL
  #BPer
  #BMS
  #B1
  #B2
  #B3
  #BMIN
  #B1X
  #BMP
  #B0
  #BPM
  #BDOT
  #BPLUS
  #BEQ 
EndEnumeration
;} 
OpenWindow(0,0,0,240,230,"calc")
StringGadget(#Output,0,0,240,30,"")
;{-
ButtonGadget(#BBack,0,30,40,40,"<-")
ButtonGadget(#BCE,40,30,40,40,"CE")
ButtonGadget(#BC,80,30,40,40,"C")
ButtonGadget(#BL,120,30,40,40,"(")
ButtonGadget(#BR,160,30,40,40,")")

;}-
;{-
ButtonGadget(#BMC,0,70,40,40,"MC")
ButtonGadget(#B7,40,70,40,40,"7")
ButtonGadget(#B8,80,70,40,40,"8")
ButtonGadget(#B9,120,70,40,40,"9")
ButtonGadget(#Bdiv,160,70,40,40,Chr(247))
ButtonGadget(#Bsqrt,200,70,40,40,"sqr")
;}
;{
ButtonGadget(#BMR,0,110,40,40,"MR")
ButtonGadget(#B4,40,110,40,40,"4")
ButtonGadget(#B5,80,110,40,40,"5")
ButtonGadget(#B6,120,110,40,40,"6")
ButtonGadget(#BMUL,160,110,40,40,"x")
ButtonGadget(#BPer,200,110,40,40,"%")
;}
;{
ButtonGadget(#BMS,0,150,40,40,"MS")
ButtonGadget(#B1,40,150,40,40,"1")
ButtonGadget(#B2,80,150,40,40,"2")
ButtonGadget(#B3,120,150,40,40,"3")
ButtonGadget(#BMIN,160,150,40,40,"-")
ButtonGadget(#B1X,200,150,40,40,"1/x")
;}
;{
ButtonGadget(#BMP,0,190,40,40,"M+")
ButtonGadget(#B0,40,190,40,40,"0")
ButtonGadget(#BPM,80,190,40,40,Chr(177))
ButtonGadget(#BDOT,120,190,40,40,".")
ButtonGadget(#BPLUS,160,190,40,40,"+")
ButtonGadget(#BEQ,200,190,40,40,"=")
;}

Repeat 
  
  ev=WaitWindowEvent()
  If ev <> 0 
    evg = EventGadget() 
    evt = EventType()
    
    If evt = #PB_EventType_LeftClick       
      
      Select evg 
        Case #B0 
          strinput + "0"
        Case #B1 
          strinput + "1"
        Case #B2 
          strinput + "2"
        Case #B3 
          strinput + "3"
        Case #B4
          strinput + "4"
        Case #B5
          strinput + "5"
        Case #B6
          strinput + "6"
        Case #B7 
          strinput + "7"
        Case #B8
          strinput + "8"
        Case #B9 
          strinput + "9"
        Case #BPLUS
          strinput + "+"
        Case #BMIN 
          strinput + "-"
        Case #BMul
          strinput + "*"
        Case #BDIV 
          strinput + "/"
        Case #BDOT
          strinput +"."
        Case #B1X 
          strinput = "1/(" + strinput + ")"
        Case #Bsqrt
          strinput + "sqrt" 
        Case #BL  
          strinput + "("
        Case #BR
          strinput + ")"
        Case #BPer 
          Define ct,strval.s,sop.s
          ct=Len(strinput)
          While *rpn\IsNumeric(Mid(strinput,ct,1)) And ct > 0
            ct-1
          Wend  
          strval = Right(strinput,Len(strinput)-ct)
          sop = Mid(strinput,ct,1)
          strinput = Left(strinput,ct)
          If sop <> "*" And sop <> "/" 
            strinput + "(" + strval + "*(" + strval + "/100))"
          Else 
            strinput + "(" + strval + "/100)"  
          EndIf   
          strinput = *rpn\eval(strinput)  
        Case #BPM 
          strinput = "-(" + strinput + ")"
        Case #BC
          strinput = ""
        Case #BCE 
          strinput =""
          memory = ""
        Case #BMS
          memory = strinput 
        Case #BMP
          memory = *rpn\eval(strinput + "+" + memory) 
        Case #BMR 
          strinput + memory
        Case #BMC
          memory = ""
        Case #BEQ 
          If strinput =""
            strinput = GetGadgetText(#output)
          EndIf 
          If strinput <> ""
            strinput = *rpn\eval(strinput)
          EndIf   
      EndSelect 
      If evg
        SetGadgetText(#output,strinput)
      EndIf
    EndIf 
  EndIf 
Until ev = #PB_Event_CloseWindow 

CompilerEndIf
Thanks, I forgot to test it with 6.30
Im sure there's a better implementation though I don't recall seeing one with variables and I also had issues with unary negation
Top
User avatar
skywalk
Addict
Addict
Posts: 4283
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Evaluate Function For Math Library

Post by skywalk »

Would be cool to add a Postfix to RPN function.
Users more familiar with ( x + y ) / 2 = instead of x y + 2 /.
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Top
User avatar
idle
Always Here
Always Here
Posts: 6154
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Evaluate Function For Math Library

Post by idle »

skywalk wrote: Fri Jan 16, 2026 11:53 pm Would be cool to add a Postfix to RPN function.
Users more familiar with ( x + y ) / 2 = instead of x y + 2 /.
That's what the RPN does. Just needs extra trig and exp log functions added
Top
User avatar
skywalk
Addict
Addict
Posts: 4283
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Evaluate Function For Math Library

Post by skywalk »

Ha! I did not catch that part, I was reading the code and thought it took in RPN notation directly like the old HP calculators? So, this can't do RPN style input, only infix.

On 2nd thought, is PB now able to import the C lib entirely with your headersection lib?
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Top
User avatar
idle
Always Here
Always Here
Posts: 6154
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Evaluate Function For Math Library

Post by idle »

It parses the infix string to the equivalent rpn string format via the classic shunting cart algorithm so it wouldn't be hard to allow rpn input if you wanted.
Put a Debug in around line 439 in evalrpn Debug *this\rpn

I'm not sure if you could use the c lib directly from source, it probably wouldn't be hard to modify to work but you would still need a c install to resolve the c types.
Top
Mesa
Enthusiast
Enthusiast
Posts: 462
Joined: Fri Feb 24, 2012 10:19 am

Re: Evaluate Function For Math Library

Post by Mesa »

PB Lizard - Script language for symbolic calculations, arbitrary large and precise numbers, parallel computing and more
from stargate

viewtopic.php?t=76279

M.
Top
Post Reply

Return to “Feature Requests and Wishlists”