In Delphi, I use a component called TMathparser to evaluate an expression to get an answer. I am trying to get it to work in Delphi Prism and it is not working out too well. In fact, there is just too many errors. So, I was wondering if there is something similar that will work with Delphi Prism.
Thanks,
I am posting the class in the hope that it might help others.
As pointed out by David, I think I have to post this here or I will have to completely remove my answer:
{==========================================================================}
{ Expression Evaluator v1.4 for Delphi }
{ (16 & 32 bits) }
{ }
{ Copyright © 1997 by BitSoft Development, L.L.C. }
{ All rights reserved }
{ }
{ Web: http://www.bitsoft.com }
{ E-mail: info@bitsoft.com }
{ Support: tech-support@bitsoft.com }
{--------------------------------------------------------------------------}
{ Portions Copyright © 1992 by Borland International, Inc. }
{ All rights reserved }
{--------------------------------------------------------------------------}
{ This file is distributed as freeware and without warranties of any kind. }
{ You can use it in your own applications at your own risk. }
{ See the License Agreement for more information. }
{==========================================================================}
Here is the modified version of Mathparser Class for Prism:
namespace MathParserClass;
interface
uses
System.Collections.Generic,
System.Collections.*,
System.Text;
type
TExtendedWrapper = class(Object)
public
MyNumber: Extended;
constructor;
end;
type
TGetVarEvent = procedure(Sender : System.Object; VarName : string; var
Value : Extended; var Found : Boolean) of object;
TParseErrorEvent = procedure(Sender : System.Object; ParseError : Integer)
of object;
const
ParserStackSize = 15;
MaxFuncNameLen = 5;
ExpLimit = 11356;
SqrLimit = 1E2466;
MaxExpLen = 4;
TotalErrors = 7;
ErrParserStack = 1;
ErrBadRange = 2;
ErrExpression = 3;
ErrOperator = 4;
ErrOpenParen = 5;
ErrOpCloseParen = 6;
ErrInvalidNum = 7;
type
ErrorRange = 0..TotalErrors;
TokenTypes = (Plus, Minus, Times, Divide, Expo, OParen, CParen, Num,
Func, EOL, Bad, ERR, Modu, tmp);
TokenRec = record
State : Byte;
Value : Extended;
FuncName : String;
end; { TokenRec }
type
MathParser = class(System.Object)
private
{ Private declarations } //moved to public
FInput : string; //was private
FOnGetVar : TGetVarEvent; //was private
FOnParseError : TParseErrorEvent; //was private
protected
CurrToken : TokenRec; //was protected begin
MathError : Boolean;
Stack : array[1..ParserStackSize] of TokenRec;
StackTop : Integer;//0..ParserStackSize;
TokenError : ErrorRange;
TokenLen : Word;
TokenType : TokenTypes;
method GotoState(Production : Word) : Word;
method IsFunc(S : String) : Boolean;
method IsVar(var Value : Extended) : Boolean;
method NextToken : TokenTypes;
method Push(Token : TokenRec);
method Pop(var Token : TokenRec);
method Reduce(Reduction : Word);
method Shift(State : Word);
//was protected end
public
{ Public declarations }
Queue: Queue; //not on-> on now
Queue2: Queue; //not on-> on now
QueueHR: Queue;
Position : Word; { Public declarations moved above}
ParseError : Boolean; { Public declarations moved above}
ParseValue : Extended; { Public declarations moved above}
TempToken : TokenRec;
constructor;
procedure Parse;
property OnGetVar : TGetVarEvent read FOnGetVar write FOnGetVar;
property OnParseError : TParseErrorEvent read FOnParseError write FOnParseError;
property ParseString : string read FInput write FInput;
end;
var
FirstTimeThru, SecondTimeThru : Boolean;
FirstTimeThruHR, SecondTimeThruHR : Boolean;
FirstTimeThru3, SecondTimeThru3 : Boolean;
FirstTimeThru4, SecondTimeThru4 : Boolean;
icnt, icnt2, icnt3, icnt4, timecount : integer;
NetAmount, NetAmount3, RunningTotalForMinute:extended;
PrevToken, PrevToken3, PrevToken4, CurrentToken :extended;
NetAmountHR, RunningTotalForHour, PrevTokenHR:extended;
CurrentTokenHR,LastResultMin, LastResultHr:extended;
toggleMin, toggleHr : boolean;
kk,jj, m : integer;
implementation
const
Letters : set of Char = ['A'..'Z', 'a'..'z'];
Numbers : set of Char = ['0'..'9'];
constructor MathParser;
begin
{ defaults }
FInput := '';
FirstTimeThru := true;
SecondTimeThru := false;
FirstTimeThruHR := true;
SecondTimeThruHR := false;
FirstTimeThru3 := true;
SecondTimeThru3 := false;
FirstTimeThru4 := true;
SecondTimeThru4 := false;
toggleMin := true;
toggleHr := true;
//TempToken.Value := 0.0;
RunningTotalForMinute := 0.0;
RunningTotalForHOUR := 0.0;
kk:=1;
jj:=1;
m:=0;
Queue := new Queue; //need this here
Queue2 := new Queue; //need this here
QueueHR := new Queue; //need this here
timecount := 0;
end;
method MathParser.GotoState(Production : Word) : Word;
{ Finds the new state based on the just-completed production and the
top state. }
var
State : Word;
begin
//GotoState := 0;
Result:=0;
State := Stack[StackTop].State;
if (Production <= 3) then
begin
case State of
0 : Result:=1; //GotoState := 1;
9 : Result:=19; //GotoState := 19;
20 : Result:=28; //GotoState := 28;
end; { case }
end
else if Production <= 6 then
begin
case State of
0, 9, 20 : Result:=2; //GotoState := 2;
12 : Result:=21; //GotoState := 21;
13 : Result:=22; //GotoState := 22;
end; { case }
end
else if (Production <= 8) or (Production = 100) then
begin
case State of
0, 9, 12, 13, 20 : Result:=3; //GotoState := 3;
14 : Result := 23; //GotoState := 23;
15 : Result := 24; //GotoState := 24;
16 : Result := 25; //GotoState := 25;
40 : Result := 80; //GotoState := 80;
end; { case }
end
else if Production <= 10 then
begin
case State of
0, 9, 12..16, 20, 40 : Result := 4; //GotoState := 4;
end; { case }
end
else if Production <= 12 then
begin
case State of
0, 9, 12..16, 20, 40 : Result := 6; //GotoState := 6;
5 : Result := 17; //GotoState := 17;
end; { case }
end
else begin
case State of
0, 5, 9, 12..16, 20, 40 : Result:=8; //GotoState := 8;
end; { case }
end;
end; { GotoState }
method MathParser.IsFunc(S : String) : Boolean;
{ Checks to see if the parser is about to read a function }
var
P, SLen : Word;
FuncName : string;
begin
P := Position;
FuncName := '';
while (P < Length(FInput)) do
begin
if (FInput[P] in ['A'..'Z', 'a'..'z', '0'..'9','_']) then
begin
FuncName := FuncName + FInput[P];
end
else
break;
Inc(P);
end; { while }
if FuncName.ToUpper = S then begin
SLen := Length(S);
CurrToken.FuncName := FInput.Substring(Position,SLen).ToUpper;
Inc(Position, SLen);
Result:=true;//IsFunc := True;
end { if }
else Result:=false;//IsFunc := False;
end; { IsFunc }
method MathParser.IsVar(var Value : Extended) : Boolean;
var
VarName : string;
VarFound : Boolean;
begin
VarFound := False;
VarName := '';
while (Position < Length(FInput)) do
begin
if (FInput[Position] in ['A'..'Z','a'..'z', '0'..'9', '_']) then
begin
VarName := VarName + FInput[Position];
end
else
break;
Inc(Position);
end; { while }
//if Assigned(FOnGetVar) then
// FOnGetVar(Self, VarName, var Value, var VarFound);
//If you notice above lines are commented out, for some reason the event assigned to it
//did not fire. So, I called the method, which is defined in another namespace or file,
//directly. It works fine. In your expression if you have a variable, this method
//varifies that it exists and that it can turn it to a value. It is totally upto you
//how you define this method. It is very important to have if you are going to have
//variables in your expression.
MathParserGetVar(self,VarName,var Value,var VarFound);
//IsVar := VarFound;
Result := VarFound;
end; { IsVar }
method MathParser.NextToken : TokenTypes;
{ Gets the next Token from the Input stream }
var
NumString : string;
TLen, NumLen : Word;
Check : Integer;
Ch : Char;
Decimal : Boolean;
tmpVar : Double;
tmpstr:String;
begin
Result:=TokenTypes.tmp;
while (Position < Length(FInput)) do
begin
if (FInput[Position] = ' ') then
Inc(Position)
else
break;
end;
TokenLen := Position;
if Position >= Length(FInput) then
begin
result:=TokenTypes.EOL;
TokenLen := 0;
Exit;
end; { if }
tmpstr:=FInput.Substring(Position,1).ToUpper;
ch:=char(tmpstr[0]);
if Ch in ['!'] then
begin
Result:=TokenTypes.ERR;
TokenLen := 0;
Exit;
end; { if }
if Ch in ['0'..'9', '.'] then
begin
NumString := '';
TLen := Position;
Decimal := False;
while (TLen < Length(FInput)) do
begin
if ((FInput[TLen] in ['0'..'9']) or ((FInput[TLen] = '.') and (not Decimal))) then
begin
NumString := NumString + FInput[TLen];
if Ch = '.' then
Decimal := True;
end
else
break;
Inc(TLen);
end; { while }
if (TLen = 2) and (Ch = '.') then
begin
Result:=TokenTypes.BAD;
TokenLen := 0;
Exit;
end; { if }
if (TLen < Length(FInput)) then
begin
tmpStr := FInput.Substring(TLen,1).ToUpper;
ch := char(tmpStr[0]);
if (Ch in ['E']) then
begin
NumString := NumString + 'E';
Inc(TLen);
if FInput[TLen] in ['+', '-'] then
begin
NumString := NumString + FInput[TLen];
Inc(TLen);
end; { if }
NumLen := 1;
while (TLen <= Length(FInput)) and (NumLen <= MaxExpLen) do
begin
if (FInput[TLen] in ['0'..'9']) then
NumString := NumString + FInput[TLen]
else
break;
Inc(NumLen);
Inc(TLen);
end; { while }
end;
end; { if }
if NumString[0] = '.' then
NumString := '0' + NumString;
if Double.TryParse(NumString, out tmpvar)=true then
begin
Check:=0;
CurrToken.Value:=tmpVar;
end
else
Check:=1;
if Check <> 0 then
begin
MathError := True;
TokenError := ErrInvalidNum;
Inc(Position, NumString.Length-1);
end { if }
else
begin
Inc(Position, NumString.Length);
TokenLen := Position - TokenLen;
Result:=TokenTypes.NUM;
end; { else }
Exit;
end { if }
else if Ch in Letters then
begin
if IsFunc('ABS') or
IsFunc('ATAN') or
IsFunc('COS') or
IsFunc('EXP') or
IsFunc('LN') or
IsFunc('ROUND') or
IsFunc('SIN') or
IsFunc('SQRT') or
IsFunc('SQR') or
IsFunc('TRUNC')
then
begin
Result:=TokenTypes.FUNC;
TokenLen := Position - TokenLen;
Exit;
end; { if }
if IsFunc('MOD') then
begin
Result:=TokenTypes.MODU;
TokenLen := Position - TokenLen;
Exit;
end; { if }
if IsVar(var CurrToken.Value)
then begin
Result:=TokenTypes.NUM;
TokenLen := Position - TokenLen;
Exit;
end { if }
else begin
Result:=TokenTypes.BAD;
TokenLen := 0;
Exit;
end; { else }
end { if }
else begin
case Ch of
'+' : Result := TokenTypes.PLUS;
'-' : Result := TokenTypes.MINUS;
'*' : Result := TokenTypes.TIMES;
'/' : Result := TokenTypes.DIVIDE;
'^' : Result := TokenTypes.EXPO;
'(' : Result := TokenTypes.OPAREN;
')' : Result := TokenTypes.CPAREN;
else begin
Result:=TokenTypes.BAD;
TokenLen := 0;
Exit;
end; { case else }
end; { case }
Inc(Position);
TokenLen := Position - TokenLen;
Exit;
end; { else if }
end; { NextToken }
procedure MathParser.Pop(var Token : TokenRec);
{ Pops the top Token off of the stack }
begin
Token := Stack[StackTop];
StackTop:=StackTop-1;
end; { Pop }
procedure MathParser.Push(Token : TokenRec);
{ Pushes a new Token onto the stack }
begin
if StackTop = ParserStackSize then
TokenError := ErrParserStack
else begin
StackTop:=StackTop+1;
Stack[StackTop] := Token;
end; { else }
end; { Push }
procedure MathParser.Parse;
{ Parses an input stream }
var
FirstToken : TokenRec;
Accepted : Boolean;
begin
Position := 0;
StackTop := 0;
TokenError := 0;
MathError := False;
ParseError := False;
Accepted := False;
FirstToken.State := 0;
FirstToken.Value := 0;
Push(FirstToken);
TokenType := NextToken;
repeat
case Stack[StackTop].State of
0, 9, 12..16, 20, 40 : begin
if TokenType = TokenTypes.NUM then
Shift(10)
else if TokenType = TokenTypes.FUNC then
Shift(11)
else if TokenType = TokenTypes.MINUS then
Shift(5)
else if TokenType = TokenTypes.OPAREN then
Shift(9)
else if TokenType = TokenTypes.ERR then
begin
MathError := True;
Accepted := True;
end { else if }
else begin
TokenError := ErrExpression;
Dec(Position, TokenLen);
end; { else }
end; { case of }
1 : begin
if TokenType = TokenTypes.EOL then
Accepted := True
else if TokenType = TokenTypes.PLUS then
Shift(12)
else if TokenType = TokenTypes.MINUS then
Shift(13)
else begin
TokenError := ErrOperator;
Dec(Position, TokenLen);
end; { else }
end; { case of }
2 : begin
if TokenType = TokenTypes.TIMES then
Shift(14)
else if TokenType = TokenTypes.DIVIDE then
Shift(15)
else
Reduce(3);
end; { case of }
3 : begin
if TokenType = TokenTypes.MODU then
Shift(40)
else
Reduce(6);
end; { case of }
4 : begin
if TokenType = TokenTypes.EXPO then
Shift(16)
else
Reduce(8);
end; { case of }
5 : begin
if TokenType = TokenTypes.NUM then
Shift(10)
else if TokenType = TokenTypes.FUNC then
Shift(11)
else if TokenType = TokenTypes.OPAREN then
Shift(9)
else
begin
TokenError := ErrExpression;
Dec(Position, TokenLen);
end; { else }
end; { case of }
6 : Reduce(10);
7 : Reduce(13);
8 : Reduce(12);
10 : Reduce(15);
11 : begin
if TokenType = TokenTypes.OPAREN then
Shift(20)
else
begin
TokenError := ErrOpenParen;
Dec(Position, TokenLen);
end; { else }
end; { case of }
17 : Reduce(9);
18 : raise Exception('Bad token state');
19 : begin
if TokenType = TokenTypes.PLUS then
Shift(12)
else if TokenType = TokenTypes.MINUS then
Shift(13)
else if TokenType = TokenTypes.CPAREN then
Shift(27)
else
begin
TokenError := ErrOpCloseParen;
Dec(Position, TokenLen);
end;
end; { case of }
21 : begin
if TokenType = TokenTypes.TIMES then
Shift(14)
else if TokenType = TokenTypes.DIVIDE then
Shift(15)
else
Reduce(1);
end; { case of }
22 : begin
if TokenType = TokenTypes.TIMES then
Shift(14)
else if TokenType = TokenTypes.DIVIDE then
Shift(15)
else
Reduce(2);
end; { case of }
23 : Reduce(4);
24 : Reduce(5);
25 : Reduce(7);
26 : Reduce(11);
27 : Reduce(14);
28 : begin
if TokenType = TokenTypes.PLUS then
Shift(12)
else if TokenType = TokenTypes.MINUS then
Shift(13)
else if TokenType = TokenTypes.CPAREN then
Shift(29)
else
begin
TokenError := ErrOpCloseParen;
Dec(Position, TokenLen);
end; { else }
end; { case of }
29 : Reduce(16);
80 : Reduce(100);
end; { case }
until Accepted or (TokenError <> 0);
if TokenError <> 0 then
begin
if TokenError = ErrBadRange then
Dec(Position, TokenLen);
if Assigned(FOnParseError)
then FOnParseError(Self, TokenError);
end; { if }
if MathError or (TokenError <> 0) then
begin
ParseError := True;
ParseValue := 0;
Exit;
end; { if }
ParseError := False;
ParseValue := Stack[StackTop].Value;
end; { Parse }
procedure MathParser.Reduce(Reduction : Word);
{ Completes a reduction }
var
Token1, Token2 : TokenRec;
begin
case Reduction of
1 : begin
Pop(var Token1);
Pop(var Token2);
Pop(var Token2);
CurrToken.Value := Token1.Value + Token2.Value;
end;
2 : begin
Pop(var Token1);
Pop(var Token2);
Pop(var Token2);
CurrToken.Value := Token2.Value - Token1.Value;
end;
4 : begin
Pop(var Token1);
Pop(var Token2);
Pop(var Token2);
CurrToken.Value := Token1.Value * Token2.Value;
end;
5 : begin
Pop(var Token1);
Pop(var Token2);
Pop(var Token2);
if Token1.Value = 0 then
MathError := True
else
CurrToken.Value := Token2.Value / Token1.Value;
end;
{ MOD operator }
100 : begin
Pop(var Token1);
Pop(var Token2);
Pop(var Token2);
if Token1.Value = 0 then
MathError := True
else
CurrToken.Value := int32(math.Round(Token2.Value)) mod int32(math.Round(Token1.Value));
end;
7 : begin
Pop(var Token1);
Pop(var Token2);
Pop(var Token2);
if Token2.Value <= 0 then
MathError := True
else if (Token1.Value * math.Log(Token2.Value) < -ExpLimit) or
(Token1.Value * math.Log(Token2.Value) > ExpLimit) then
MathError := True
else
CurrToken.Value := math.Exp(Token1.Value * math.log(Token2.Value));
end;
9 : begin
Pop(var Token1);
Pop(var Token2);
CurrToken.Value := -Token1.Value;
end;
//11 : raise Exception('Invalid reduction');
//13 : raise Exception('Invalid reduction');
14 : begin
Pop(var Token1);
Pop(var CurrToken);
Pop(var Token1);
end;
16 : begin
Pop(var Token1);
Pop(var CurrToken);
Pop(var Token1);
Pop(var Token1);
if Token1.FuncName = 'ABS' then
CurrToken.Value := math.Abs(CurrToken.Value)
else if Token1.FuncName = 'ATAN' then
CurrToken.Value := math.Atan(CurrToken.Value)
else if Token1.FuncName = 'COS' then
begin
if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
MathError := True
else
CurrToken.Value := math.Cos(CurrToken.Value)
end
else if Token1.FuncName = 'EXP' then
begin
if (CurrToken.Value < -ExpLimit) or (CurrToken.Value > ExpLimit) then
MathError := True
else
CurrToken.Value := math.Exp(CurrToken.Value);
end
else if Token1.FuncName = 'LN' then
begin
if CurrToken.Value <= 0 then
MathError := True
else
CurrToken.Value := Math.Log(CurrToken.Value);
end
else if Token1.FuncName = 'ROUND' then
begin
if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
MathError := True
else
CurrToken.Value := math.Round(CurrToken.Value);
end
else if Token1.FuncName = 'SIN' then
begin
if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
MathError := True
else
CurrToken.Value := math.Sin(CurrToken.Value)
end
else if Token1.FuncName = 'SQRT' then
begin
if CurrToken.Value < 0 then
MathError := True
else
CurrToken.Value := math.Sqrt(CurrToken.Value);
end
else if Token1.FuncName = 'SQR' then
begin
if (CurrToken.Value < -1000000) or (CurrToken.Value > 1000000) then
MathError := True
else
CurrToken.Value := (CurrToken.Value*CurrToken.Value);
end
else if Token1.FuncName = 'TRUNC' then
begin
if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
MathError := True
else
CurrToken.Value := math.Truncate(CurrToken.Value);
end;
end;
3, 6, 8, 10, 12, 15 : Pop(var CurrToken);
end; { case }
CurrToken.State := GotoState(Reduction);
Push(CurrToken);
end; { Reduce }
procedure MathParser.Shift(State : Word);
{ Shifts a Token onto the stack }
begin
CurrToken.State := State;
Push(CurrToken);
TokenType := NextToken;
end; { Shift }
constructor TExtendedWrapper;
begin
end;
end.
Here is the implementation detail for method MathParseronGetVar:
method YourClass.MathParserGetVar(sender: Object; VarName: String; var Value: Extended; var VarFound: Boolean);
var
theSig:TSignal;
begin
theSig := FindSignal(VarName); //My variables are linked to external devices. Yours could simply two dimensional arraylist with variable and its value.
if theSig <> nil then
begin
Value := theSig.AsReal;
VarFound := true;
end
else
begin
VarFound := false;
end;
end;
Here is how one would use MathParser class. By the way this class will easily handle complex expression.
var theparser := new Mathparser;
with theparser do
begin
ParseString := '(COS((33*5))*TAN(X))+SQRT(100)';
Parse;
if not ParseError then
Edit2.Text := string.Format('{0}',ParseValue)
else
Edit2.Text := '#Error';
end;
I think you may still need to modify Mathparser to work with your program, but it would be very simple.