NewsForumsCodeLogsGallerySpecsSearch

Code archives/Algorithms/Expression Evaluator

This code has been declared by its author to be Public Domain code.

Download source code

Expression Evaluator by grable2007
This little pieace of code parses & evaluates string expressions.

It handles variables,constants and functions with 0 to 2 parameters, like Sin/Cos/Atan2 etc.

Allso able to assign the value to registered variables or temporary variables.

UPDATE: now handles several lines seperated by ;

Public API:
Function RegisterVariable( ident:String, p:Double Ptr)
Function RegisterConstant( ident:String, value:Double)
Function RegisterFunction( ident:String, p:Byte Ptr, pcount:Int)
Function UnregisterIdent( ident:String)
Function UnregisterAllIdents()
Function ClearIdentValues()
Function Expression:Double( s:String)

Example usage:
Global a:Double = 5
RegisterConstant( "pi", Pi)
RegisterVariable( "a", Varptr a)
RegisterFunction( "sin", Sin, 1)
RegisterFunction( "atan2", ATan2, 2)

Print "> sin(pi * a) + atan2(-2 / 1, a - 2)"
Print "="+(Sin(Pi * a) + ATan2(-2 / 1, a - 2))
Print "----------------------------------------"
Print "=" + Expression( "x = sin(pi * a) + atan2(-2 / 1, a - 2)")
Print "=" + Expression( "a = x;~n a * 2")
ClearIdentValues()
Print "=" + Expression( "x")
Print "=" + a

Import BRL.StandardIO
Import BRL.Map
Import BRL.Math

Private

Const EXPR_VAR:Int = 1
Const EXPR_VALUE:Int = 2
Const EXPR_CONST:Int = 3
Const EXPR_FUNC0:Int = 4
Const EXPR_FUNC1:Int = 5
Const EXPR_FUNC2:Int = 6

Type TExprIdent
	Field Tag:Int
	Field Value:Double
	Field V:Double Ptr	
	Field F0:Double()
	Field F1:Double( value:Double)
	Field F2:Double( value1:Double, value2:Double)

	Function CreateVar:TExprIdent( p:Double Ptr)
		Local v:TExprIdent = New TExprIdent
		v.Tag = EXPR_VAR
		v.V = p
		Return v
	EndFunction
	
	Function CreateConst:TExprIdent( value:Double)
		Local v:TExprIdent = New TExprIdent
		v.Tag = EXPR_CONST
		v.Value = value
		Return v		
	EndFunction
	
	Function CreateValue:TExprIdent( value:Double)
		Local v:TExprIdent = New TExprIdent
		v.Tag = EXPR_VALUE
		v.Value = value
		Return v		
	EndFunction	

	Function CreateFunc:TExprIdent( pcount:Int, p:Byte Ptr)
		Local v:TExprIdent = New TExprIdent
		Select pcount
			Case 0 
				v.Tag = EXPR_FUNC0
				v.F0 = p
			Case 1 
				v.Tag = EXPR_FUNC1
				v.F1 = p
			Case 2 
				v.Tag = EXPR_FUNC2				
				v.F2 = p
		EndSelect		
		Return v
	EndFunction	
EndType

Global source:String
Global pos:Int
Global idents:TMap = New TMap

Function ReportError( s:String, printpos:Int = True)
	If printpos Then 
		Print "ERROR: pos="+pos+" : "+s
	Else
		Print "ERROR: "+s
	EndIf
EndFunction

Function LookupVariable:Double( ident:String)
	Local v:TExprIdent = TExprIdent( idents.ValueForKey( ident))
	If v Then 
		Select v.Tag
			Case EXPR_VAR 
				Return v.V[0]
			Case EXPR_VALUE, EXPR_CONST 
				Return v.Value
			Default
				ReportError( "identifier not a variable => " + ident, False)
		EndSelect		
		Return 0
	EndIf
	ReportError( "variable not defined => " + ident, False)
	Return 0
EndFunction

Function CallFunction:Double( ident:String, pcount:Int=0,  value1:Double=0, value2:Double=0)
	Local v:TExprIdent = TExprIdent( idents.ValueForKey( ident))
	If v Then
		Select v.Tag
			Case EXPR_FUNC0 
				If pcount = 0 Then Return v.F0()
				ReportError( "invalid parameter count " + pcount + " expected 0")
			Case EXPR_FUNC1 
				If pcount = 1 Then Return v.F1( value1)
				ReportError( "invalid parameter count " + pcount + " expected 1")
			Case EXPR_FUNC2 
				If pcount = 2 Then Return v.F2( value1, value2)
				ReportError( "invalid parameter count " + pcount + " expected 2")
			Default
				ReportError( "identifier not a function => " + ident, False)				
		EndSelect
		Return 0
	EndIf
	ReportError( "function not defined => " + ident, False)
	Return 0
EndFunction

Function EatWhitespace()
	While (source[pos] = Asc(" ")) Or (source[pos] = Asc("~t")) Or (source[pos] = Asc("~n")) Or (source[pos] = Asc("~r"))
		pos :+ 1
	Wend
EndFunction

Function EatIdent:String()
	Local start:Int = pos
	While ((source[pos] >= Asc("a")) And (source[pos] <= Asc("z"))) Or ..
		((source[pos] >= Asc("A")) And (source[pos] <= Asc("Z"))) Or ..
		((source[pos] >= Asc("0")) And (source[pos] <= Asc("9"))) Or (source[pos] = Asc("_"))
		pos :+ 1
	Wend
	Return source[start..pos]
EndFunction

Function EatNumber:Double()
	Local start:Int = pos
	Local gotsep:Int = False
	Local res:String	
	While (source[pos] >= Asc("0")) And (source[pos] <= Asc("9"))
		pos :+ 1
		If source[pos] = Asc(".") Then
			If gotsep Then ReportError( "error in Double number")
			gotsep = True
			pos :+ 1
		EndIf
	Wend
	Return source[start..pos].ToDouble()
EndFunction

Function Primary:Double()
	Local lvalue:Double
	EatWhitespace()
	If source[pos] = Asc("(") Then
		pos :+ 1
		lvalue = AddExpression()
    		If source[pos] <> Asc(")") Then ReportError( "expected )")
    		pos :+ 1
	ElseIf (source[pos] >= Asc("0")) And (source[pos] <= Asc("9")) Then
		lvalue = EatNumber()
	ElseIf source[pos] = Asc("-") Then
		pos :+ 1
		lvalue = - AddExpression()
	ElseIf ((source[pos] >= Asc("a")) And (source[pos] <= Asc("z"))) Or ..
		((source[pos] >= Asc("A")) And (source[pos] <= Asc("Z"))) Or (source[pos] = Asc("_")) Then
		Local ident:String = EatIdent()
		If source[pos] = Asc("(") Then
			pos :+ 1
			EatWhitespace()
			If source[pos] = Asc(")") Then
				' no parameters
				pos :+ 1
				lvalue = CallFunction( ident)
			Else			
				Local rvalue1:Double = AddExpression()
				If source[pos] = Asc(")") Then
					' 1 parameter
					pos :+ 1
					lvalue = CallFunction( ident, 1, rvalue1)
				ElseIf source[pos] = Asc(",") Then
					' 2 parameters
					pos :+ 1
					Local rvalue2:Double = AddExpression()					
		    			If source[pos] <> Asc(")") Then ReportError( "expected )")
	    				pos :+ 1			
					lvalue = CallFunction( ident, 2, rvalue1, rvalue2)
				Else
					ReportError( "invalid function expression => " + ident)
				EndIf
			EndIf
		Else
			' variable lookup
			lvalue = LookupVariable( ident)
		EndIf
	Else
		ReportError( "expected number or -number or (expression)")
	EndIf
	EatWhitespace()
	Return lvalue
EndFunction

Function MulExpression:Double()
	Local lvalue:Double, rvalue:Double
	EatWhitespace()
	lvalue = Primary()
	While (source[pos] = Asc("*")) Or (source[pos] = Asc("/"))
		If source[pos] = Asc("*") Then
			pos :+ 1
			rvalue = Primary()
			lvalue = lvalue * rvalue
		ElseIf source[pos] = Asc("/") Then
			pos :+ 1
			rvalue = Primary()
			lvalue = lvalue / rvalue
		EndIf
	Wend
	EatWhitespace()
	Return lvalue
EndFunction
	
Function AddExpression:Double()
	Local lvalue:Double, rvalue:Double
	EatWhitespace()
	lvalue = MulExpression()
	While (source[pos] = Asc("+")) Or (source[pos] = Asc("-")) 
		If source[pos] = Asc("+") Then
			pos :+ 1
			rvalue = MulExpression()
			lvalue = lvalue + rvalue
		ElseIf source[pos] = Asc("-") Then
			pos :+ 1
			rvalue = MulExpression()
			lvalue = lvalue - rvalue		
		EndIf
	Wend
	EatWhitespace()
	Return lvalue
EndFunction

Public

Function RegisterVariable( ident:String, p:Double Ptr)
	idents.Insert( ident, TExprIdent.CreateVar( p))	
EndFunction

Function RegisterConstant( ident:String, value:Double)
	idents.Insert( ident, TExprIdent.CreateConst( value))	
EndFunction

Function RegisterFunction( ident:String, p:Byte Ptr, pcount:Int)
	If (pcount >= 0) And (pcount <= 2) Then idents.Insert( ident, TExprIdent.CreateFunc( pcount, p))
EndFunction

Function UnregisterIdent( ident:String)
	idents.Remove( ident)
EndFunction

Function UnregisterAllIdents()
	idents.Clear()
EndFunction

Function ClearIdentValues()
	For Local node:TNode = EachIn idents
		If TExprIdent(node._value).Tag = EXPR_VALUE Then idents.Remove( node._key)
	Next
EndFunction

Function Expression:Double( s:String)
	Local result:Double, ident:String, idx:Int
	source = s.Trim()
	pos = 0
	idx = source.Find( "=")
	If idx > 0 Then
		ident = EatIdent()
		EatWhitespace()
		pos :+ 1
	ElseIf idx = 0 Then
		ReportError( "invalid assignment", False)
		Return 0
	EndIf
	result = AddExpression()
	If ident.Length > 0 Then 
		Local v:TExprIdent = TExprIdent( idents.ValueForKey( ident))
		If v Then 
			Select v.Tag
				Case EXPR_VAR 
					v.V[0] = result
				Case EXPR_VALUE
					v.Value = result
				Case EXPR_CONST 
					ReportError( "unable to assign to constant " + ident, False)
			EndSelect
		Else
			idents.Insert( ident, TExprIdent.CreateValue( result))
		EndIf		
	EndIf
	' more "lines" ?
	If pos < source.Length Then
		If source[pos] = Asc(";") Then
			pos :+ 1
			If pos < source.Length Then
				EatWhitespace()
				Return Expression( source[pos..])
			EndIf
			Return result
		EndIf
		ReportError( "invalid expression")
		Return 0		
	EndIf
	Return result
EndFunction

Comments

None.

Code Archives Forum