Code archives/Algorithms/Term calculator
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| As the title suggests, this algorithm calculates the result of a mathematical term passed over in a string. It's able to do most of the basic stuff like addition, substraction, multiplication, division and can also handle brackets, powers (like 2^5) and boolean comparisons. You're also able to use variables - just take a look at the example. In the code, two functions are important: - TermTokenize( Calc$ ): This Functions splits the given term into single tokens and returns the first token. The returned type is a TTerm, which can later be used in - TermCalculate( Term.TTerm, Vars$ ) to calculate the result of the term. It's last parameter is optional. If you've used any variables in your term, you must allocate them values in the string. The description is maybe a bit confusing since my English is not very good, but I hope an example will do better. Let's say, you have a string that contains "X^(2-Test)+300". First of all you call TermTokenize and store the returned type for later use: Term.TTerm = TermTokenize( "X^(2-Test)+300" ) Now you can call TermCalculate later in your code and assign values to these variables: Result# = TermCalculate( Term, "X=3,Test=1.5" ) This is useful anywhere the user could type in mathematical expressions, for example script languages or graph plotters. The code contains the functions used by the algorithm along with a small example (it just draws a bunch of different graphs and displays how long it took). So far I haven't found any bugs, but if you encounter any, please tell me. | |||||
Const GWIDTH = 800
Const GHEIGHT = 600
Graphics 800, 600, 0, 2
SetBuffer BackBuffer()
Graph1.TTerm = TermTokenize( "-(((X-400)*Scale)^2-300)" )
Graph2.TTerm = TermTokenize( "-(1/((X-400)*Scale)-300)" )
Graph3.TTerm = TermTokenize( "-(2^((X-400)*Scale)-300)" )
Graph4.TTerm = TermTokenize( "-100*(X<=(800/2))+300" )
Timer = CreateTimer( 60 )
While Not KeyHit( 1 )
Cls
Counter = MilliSecs()
PlotGraph( Graph1, "Scale=0.05", $FFFF0000 )
PlotGraph( Graph2, "Scale=0.0001", $FF00FF00 )
PlotGraph( Graph3, "Scale=0.03", $FF0000FF )
PlotGraph( Graph4, "", $FFFFFF00 )
Text 0, 0, MilliSecs() - Counter
Flip 0
WaitTimer Timer
Wend
End
Function PlotGraph( Graph.TTerm, VarString$, ARGB )
LockBuffer BackBuffer()
For X = 0 To GWIDTH - 1
WritePixel X, TermCalculate( Graph, VarString$ + ",X=" + X ), ARGB
Next
UnlockBuffer BackBuffer()
End Function
;############################# Everithing beyond this line is used by the algorithm, everything above this line is just the example.
Type TTerm
Field Action
Field P#
Field PVar$
Field PTerm.TTerm
Field Result#
End Type
Const TERM_INITIATE = 1
Const TERM_ADD = 2
Const TERM_SUBSTRACT = 3
Const TERM_MULTIPLY = 4
Const TERM_DIVIDE = 5
Const TERM_GREATER = 6
Const TERM_SMALLER = 7
Const TERM_EQUAL = 8
Const TERM_GREATEREQUAL = 9
Const TERM_SMALLEREQUAL = 10
Const TERM_END = 11
Global ResultTerm.TTerm
Function TermTokenize.TTerm( Calc$ )
Term.TTerm = New TTerm
Term\Action = TERM_INITIATE
If Left( Calc$, 1 ) <> "-" Then Calc$ = "+" + Calc$
While Calc$ <> ""
Term.TTerm = New TTerm
If FirstTerm.TTerm = Null Then FirstTerm = Term
Select Left( Calc$, 1 )
Case "-"
Term\Action = TERM_SUBSTRACT
Case "+"
Term\Action = TERM_ADD
Case "*"
Term\Action = TERM_MULTIPLY
Case "/"
Term\Action = TERM_DIVIDE
Case "^"
Term\Action = TERM_EXPONENT
Case ">"
If Mid( Calc$, 2, 1 ) = "=" Then
Term\Action = TERM_GREATEREQUAL
Calc$ = Right( Calc$, Len( Calc$ ) - 1 )
Else
Term\Action = TERM_GREATER
EndIf
Case "<"
If Mid( Calc$, 2, 1 ) = "=" Then
Term\Action = TERM_SMALLEREQUAL
Calc$ = Right( Calc$, Len( Calc$ ) - 1 )
Else
Term\Action = TERM_SMALLER
EndIf
Case "="
Term\Action = TERM_EQUAL
End Select
Offset = FindOperand( Calc$, 2 )
If Offset = 0 Then Offset = Len( Calc$ ) + 1
Param$ = Mid( Calc$, 2, Offset - 2 )
If IsLetter( Left( Param$, 1 ) ) Then
Term\PVar$ = Param$
ElseIf Left( Param$, 1 ) = "(" Then
Term\PTerm = TermTokenize( Right( Left( Param$, Len( Param$ ) - 1 ), Len( Param$ ) - 2 ) )
Else
Term\P# = Float( Param$ )
EndIf
DebugLog Left( Calc$, 1 ) + Param$
Calc$ = Right( Calc$, Len( Calc$ ) - Offset + 1 )
Wend
Term.TTerm = New TTerm
Term\Action = TERM_END
Return FirstTerm
End Function
Function TermCalculate#( Term.TTerm, Vars$ = "" )
Local Result# = 0
If Term = Null Then Return 0
While Term\Action <> TERM_END
If Term\PVar$ <> "" Then
Offset = Standalone( Lower( Vars$ ), Lower( Term\PVar$ ) )
If Offset Then
Offset = Offset + Len( Term\PVar$ )
Offset2 = Instr( Vars$, ",", Offset )
If Offset2 = 0 Then Offset2 = Len( Vars$ )
Term\P# = Float( Mid( Vars$, Offset + 1, Offset2 - Offset ) )
Else
RuntimeError "Undefined Variable: '" + Term\PVar$ + "'!
EndIf
ElseIf Term\PTerm <> Null
Term\P# = TermCalculate( Term\PTerm, Vars$ )
EndIf
Select Term\Action
Case TERM_ADD
Result# = Result# + Term\P#
Term\Result# = Term\P#
Case TERM_SUBSTRACT
Result# = Result# - Term\P#
Term\Result# = -Term\P#
Case TERM_MULTIPLY
ParamTerm.TTerm = Before Term
Result# = Result# - ParamTerm\Result#
Result# = Result# + Term\P#*ParamTerm\Result#
Term\Result# = Term\P#*ParamTerm\Result#
Case TERM_DIVIDE
ParamTerm.TTerm = Before Term
Result# = Result# - ParamTerm\Result#
Result# = Result# + ParamTerm\Result#/Term\P#
Term\Result# = ParamTerm\Result#/Term\P#
Case TERM_EXPONENT
ParamTerm.TTerm = Before Term
Result# = Result# - ParamTerm\Result#
Select ParamTerm\Action
Case TERM_MULTIPLY
ParamTerm\Result# = ParamTerm\Result#/ParamTerm\P#
If Term\P# = 0 Then
Term\Result# = 1
ElseIf Float( Int( Term\P# ) ) = Term\P# Then
Term\Result# = ParamTerm\Result#
For i = 1 To Term\P# - 1
Term\Result# = Term\Result#*ParamTerm\Result#
Next
Else
Term\Result# = ParamTerm\Result#^Term\P#
EndIf
Result# = Result# + Term\Result#*ParamTerm\Result#
Case TERM_DIVIDE
ParamTerm\Result# = ParamTerm\Result#*ParamTerm\P#
If Term\P# = 0 Then
Term\Result# = 1
ElseIf Float( Int( Term\P# ) ) = Term\P# Then
Term\Result# = ParamTerm\Result#
For i = 1 To Term\P# - 1
Term\Result# = Term\Result#*ParamTerm\Result#
Next
Else
Term\Result# = ParamTerm\Result#^Term\P#
EndIf
Result# = Result# + ParamTerm\Result#/Term\Result#
Default
If Term\P# = 0 Then
Term\Result# = 1
ElseIf Float( Int( Term\P# ) ) = Term\P# Then
Term\Result# = ParamTerm\Result#
For i = 1 To Term\P# - 1
Term\Result# = Term\Result#*ParamTerm\Result#
Next
Else
Term\Result# = ParamTerm\Result#^Term\P#
EndIf
Result# = Result# + Term\Result#
End Select
Case TERM_GREATER
ParamTerm.TTerm = Before Term
Result = Result - ParamTerm\Result#
Result# = Result# + ( ParamTerm\Result# > Term\P# )
Case TERM_EQUAL
ParamTerm.TTerm = Before Term
Result = Result - ParamTerm\Result#
Result# = Result# + ( ParamTerm\Result# = Term\P# )
Case TERM_SMALLER
ParamTerm.TTerm = Before Term
Result = Result - ParamTerm\Result#
Result# = Result# + ( ParamTerm\Result# < Term\P# )
Case TERM_GREATEREQUAL
ParamTerm.TTerm = Before Term
Result = Result - ParamTerm\Result#
Result# = Result# + ( ParamTerm\Result# >= Term\P# )
Case TERM_SMALLEREQUAL
ParamTerm.TTerm = Before Term
Result = Result - ParamTerm\Result#
Result# = Result# + ( ParamTerm\Result# <= Term\P# )
End Select
If Term\PTerm <> Null Then Term = After ResultTerm Else Term = After Term
Wend
Term\Result# = Result#
ResultTerm = Term
Return Result#
End Function
Function Standalone( SourceString$, SearchString$, Offset = 1 )
Offset = Instr( SourceString$, SearchString$, Offset )
While Offset
If Offset > 1 Then LeftEnd$ = Mid( SourceString$, Offset - 1, 1 ) Else LeftEnd$ = ","
RightEnd$ = Mid( SourceString$, Offset + Len( SearchString$ ), 1 )
If RightEnd$ = "=" And LeftEnd$ = "," Then Return Offset Else Offset = Instr( SourceString$, SearchString$, Offset + 1 )
Wend
Return False
End Function
Function IsLetter( Char$ )
If Asc( Char$ ) >= 65 And Asc( Char$ ) <= 90 Then Return True
If Asc( Char$ ) >= 97 And Asc( Char$ ) <= 122 Then Return True
End Function
Function IsInBrackets( SourceString$, Offset )
OffsetBracket = Instr( SourceString$, "(" )
While OffsetBracket
Level = 1
OffsetOpenBracket = OffsetBracket
OffsetCloseBracket = 0
While Level > 0
OffsetOpenBracket = Instr( SourceString$, "(", OffsetOpenBracket + 1 )
OffsetCloseBracket = Instr( SourceString$, ")", OffsetCloseBracket + 1 )
If OffsetCloseBracket > 0 And ( OffsetCloseBracket < OffsetOpenBracket Or OffsetOpenBracket = 0 ) Then
If Level - 1 = 0 Then Exit
EndIf
If OffsetOpenBracket Then Level = Level + 1
If OffsetCloseBracket Then Level = Level - 1
Wend
If Offset > OffsetBracket And Offset < OffsetCloseBracket Then
If OffsetBracket > 1 Then
Char$ = Mid( SourceString$, OffsetBracket - 1, 1 )
If Not IsLetter( Char$ ) Then Return True
EndIf
Char$ = Mid( SourceString$, OffsetCloseBracket + 1, 1 )
If Not IsLetter( Char$ ) Then Return True
EndIf
OffsetBracket = Instr( SourceString$, "(", OffsetBracket + 1 )
Wend
Return False
End Function
Function FindOperand( SourceString$, Offset = 1 )
OffsetPlus = Instr( SourceString$, "+", Offset )
OffsetMinus = Instr( SourceString$, "-", Offset )
OffsetStar = Instr( SourceString$, "*", Offset )
OffsetSlash = Instr( SourceString$, "/", Offset )
OffsetCaret = Instr( SourceString$, "^", Offset )
OffsetSmaller = Instr( SourceString$, "<", Offset )
OffsetBigger = Instr( SourceString$, ">", Offset )
OffsetEqual = Instr( SourceString$, "=", Offset )
If OffsetPlus = 0 Then OffsetPlus = 999999
If OffsetMinus = 0 Then OffsetMinus = 999999
If OffsetStar = 0 Then OffsetStar = 999999
If OffsetSlash = 0 Then OffsetSlash = 999999
If OffsetCaret = 0 Then OffsetCaret = 999999
If OffsetSmaller = 0 Then OffsetSmaller = 999999
If OffsetBigger = 0 Then OffsetBigger = 999999
If OffsetEqual = 0 Then OffsetEqual = 999999
MinValue = Minimum( OffsetPlus, OffsetMinus )
MinValue = Minimum( MinValue, OffsetStar )
MinValue = Minimum( MinValue, OffsetSlash )
MinValue = Minimum( MinValue, OffsetCaret )
MinValue = Minimum( MinValue, OffsetSmaller )
MinValue = Minimum( MinValue, OffsetBigger )
MinValue = Minimum( MinValue, OffsetEqual )
If MinValue = 999999 Then Return False
If IsInBrackets( SourceString$, MinValue ) Then MinValue = FindOperand( SourceString$, MinValue + 1 )
Return MinValue
End Function
Function Minimum( ValueA, ValueB )
If ValueA < ValueB Then Return ValueA Else Return ValueB
End Function |
Comments
| ||
| Nice! |
| ||
| Very nice. |
| ||
| I'm working on a "Countdown" game (as per the tv show) and this kinda thing is ideal for the 'numbers game' Very nice, thank you, Noobody. |
Code Archives Forum
   |