Evaluate Equation

Category: Math

Date: 03-28-2012

Return to Index


 
'Primary Code:
'Credit: Jean-Pierre Leroy (Jan, 2010)
'See the three functions below
 
 
'Compilable Example:
'Note the use of () to surround variable values. This is needed to allow
'for the use of negative values.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg as DWord
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 50,10,100,20
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      Local x,y As Single, Expr As String
      x = 5  :  y = 5
      Expr = "x*x + y*y"
      Replace "x" With "(" + Str$(x) + ")" In Expr
      Replace "y" With "(" + Str$(y) + ")" In Expr
      MsgBox Str$(Evaluate(Expr))
   End If
End Function
 
Function Evaluate(ByVal pExpression As StringAs Single
   Local lExpression As String
   lExpression = PrepExpNum(pExpression)      ' PREPare the NUMerical EXPexpression before the evaluation
   Function = EvalExpNum(lExpression)
End Function
 
Function PrepExpNum(ByRef pExpression As StringAs String
   Local lNewExpression As String
   lNewExpression = UCase$(Trim$(pExpression))
   Replace "LOG10" With "LOGTEN"  In lNewExpression
   Replace "LOG2"  With "LOGTWO"  In lNewExpression
   Replace "EXP10" With "EXPTEN"  In lNewExpression
   Replace "EXP2"  With "EXPTWO"  In lNewExpression
   Replace "PI"    With "3.14159" In lNewExpression
   Replace "-"     With "_"       In lNewExpression  ' to avoid any confusion with a negative value
   Function = lNewExpression
End Function
 
Function EvalExpNum(ByVal pExpression As StringAs Single      'Extended
   Local    lOpenParentheseStart, lOpenParentheseCounter, lCloseParentheseCounter As Long
   Local    lCurrentPos, lI, lPosOperator, lLeftOperandStart As Long
   Local    lleftOperandEnd, lRightOperandStart, lRightOperandEnd As Long
   Local    lEval, lLeftOperand, lRightOperand As Single         'Extended
 
   Do
      lOpenParentheseCounter  = 0 : lCloseParentheseCounter = 0   'reset the parentheses counters
      lOpenParentheseStart = Instr(pExpression, "(")              'search for a open parenthese "(" in the expression
      If lOpenParentheseStart <> 0 Then                           'only if we find a open parenthese "(" in the expression
         lOpenParentheseCounter = 1                              'initialize the open parenthese counter to 1
         lCurrentPos = lOpenParentheseStart                      'we start at the open parenthese
         Do
            Incr lCurrentPos                                    'increment the current position
            If Mid$(pExpression, lCurrentPos, 1) = ")Then Incr lCloseParentheseCounter    ' to count the number of parentheses
            If Mid$(pExpression, lCurrentPos, 1) = "(Then Incr lOpenParentheseCounter
         Loop Until lOpenParentheseCounter = lCloseParentheseCounter
 
         pExpression = Left$(pExpression,lOpenParentheseStart-1)+ _    'recursive call to EvalExpNum
            Format$(EvalExpNum(Mid$(pExpression,lOpenParentheseStart+1,lCurrentPos-lOpenParentheseStart-1)))+ _
            Right$(pExpression,-lCurrentPos)
      Else
         Data "ATN", "COS", "SIN", "TAN", "LOGTEN", "LOGTWO", "LOG", "EXPTEN"
         Data "EXPTWO", "EXP", "SQR", "ABS", "^", "*", "/", "\", "MOD", "_", "+"
         For lI = 1 To Datacount                ' check all the Operators/Functions that could be used in the numerical expression
            Do                                ' examines all the occurences of the operator/function
               lPosOperator = Instr(pExpression,Read$(lI))
               If lPosOperator <> 0 Then               ' only if we find the Operator/Function
                  lLeftOperandEnd = lPosOperator-1    ' search the start/end of the left operand
                  lCurrentPos     = lPosOperator
                  Do
                     Decr lCurrentPos                     ' decrement current pos
                     If   lCurrentPos < 1 Then Exit Loop  ' if we are out of the string
                  Loop Until Instr(" 0123456789.-",Mid$(pExpression, lCurrentPos, 1)) = 0
                  lLeftOperandStart = lCurrentPos+1
 
                  lRightOperandStart = lPosOperator+Len(Read$(lI))    ' search the start/end of the right operand
                  lCurrentPos          = lPosOperator+Len(Read$(lI))-1
                  Do
                     Incr lCurrentPos                                     ' decrement current pos
                     If   lCurrentPos > Len(pExpression) Then Exit Loop   ' if we are out of the string
                  Loop Until Instr(" 0123456789.-",Mid$(pExpression, lCurrentPos, 1)) = 0
                  lRightOperandEnd = lCurrentPos - 1
 
                  lLeftOperand  = Val(Trim$(Mid$(pExpression,lLeftOperandStart ,lLeftOperandEnd -lLeftOperandStart +1))) ' extract the operands removing spaces
                  lRightOperand = Val(Trim$(Mid$(pExpression,lRightOperandStart,lRightOperandEnd-lRightOperandStart+1))) ' extract the operands removing spaces
 
                  Select Case Read$(lI)                     ' depending of the Operator/Function
                     Case "ATN"     :  lEval = Atn(lRightOperand)
                     Case "COS"     :  lEval = Cos(lRightOperand)
                     Case "SIN"     :  lEval = Sin(lRightOperand)
                     Case "TAN"     :  lEval = Tan(lRightOperand)
                     Case "LOGTEN"  :  lEval = Log10(lRightOperand)
                     Case "LOGTWO"  :  lEval = Log2(lRightOperand)
                     Case "LOG"     :  lEval = Log(lRightOperand)
                     Case "EXPTEN"  :  lEval = Exp10(lRightOperand)
                     Case "EXPTWO"  :  lEval = Exp2(lRightOperand)
                     Case "EXP"     :  lEval = Exp(lRightOperand)
                     Case "SQR"     :  lEval = Sqr(lRightOperand)
                     Case "ABS"     :  lEval = ABS(lRightOperand)
                     Case "^"       :  lEval = lLeftOperand ^ lRightOperand
                     Case "*"       :  lEval = lLeftOperand * lRightOperand
                     Case "/"       :  lEval = lLeftOperand / lRightOperand
                     Case "\"       :  lEval = lLeftOperand \ lRightOperand
                     Case "MOD"     :  lEval = lLeftOperand Mod lRightOperand
                     Case "_"       :  lEval = lLeftOperand - lRightOperand
                     Case "+"       :  lEval = lLeftOperand + lRightOperand
                  End Select
                  lEval = Round(lEval, 2)  'round the evaluation to 6 decimal places to avoid scientific notation (E-)
                  pExpression = Left$(pExpression,lLeftOperandStart-1)+Format$(lEval)+Right$(pExpression,-lRightOperandEnd) 'place the result of the evaluation in the string
               End If
            Loop Until lPosOperator = 0
         Next lI
         Function = Val(pExpression)  'to evaluate the final expression
      End If
   Loop Until lOpenParentheseStart = 0
 
End Function
 
'gbs_00570
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm