PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Evaluate Function For Math Library

https://www.purebasic.fr/english/viewtopic.php?t=88199

Page 1 of 1

Evaluate Function For Math Library

Posted: Fri Jan 16, 2026 7:27 pm
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.

Re: Evaluate Function For Math Library

Posted: Fri Jan 16, 2026 10:15 pm
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

Re: Evaluate Function For Math Library

Posted: Fri Jan 16, 2026 10:43 pm
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

Re: Evaluate Function For Math Library

Posted: Fri Jan 16, 2026 11:04 pm
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

Re: Evaluate Function For Math Library

Posted: Fri Jan 16, 2026 11:53 pm
by skywalk
Would be cool to add a Postfix to RPN function.
Users more familiar with ( x + y ) / 2 = instead of x y + 2 /.

Re: Evaluate Function For Math Library

Posted: Sat Jan 17, 2026 3:25 am
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

Re: Evaluate Function For Math Library

Posted: Sat Jan 17, 2026 6:12 am
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?

Re: Evaluate Function For Math Library

Posted: Sat Jan 17, 2026 9:31 am
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.

Re: Evaluate Function For Math Library

Posted: Sat Jan 17, 2026 10:17 am
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.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited