unit ExprParser;
interface
uses
SysUtils;
type
TFuncCallHandler = function(Name: string; const Values: array of Double):
Double;
EParseError = class(EAbort);
{
使用範例：
EvaluateExpr('x+y*z', ['x','y','z'], [1,2,3]);
代表令x=1,y=2,z=3，算出x+y*z的值
}
function EvaluateExpr(Expr: string; const Variables: array of string;
const VarValues: array of Double; FuncCallHandler: TFuncCallHandler = nil)
: Single;
function EvaluateToStr(Text: string; const Variables: array of string; const VarValues: array of Double): string;
procedure TestParser;
implementation
uses
Classes, Math;
procedure Error(Msg: string);
begin
raise EParseError.Create(Msg);
end;
function EvaluateExpr(Expr: string; const Variables: array of string;
const VarValues: array of Double; FuncCallHandler: TFuncCallHandler = nil)
: Single;
var
P: Integer;
PeekedToken: string;
IsTokenPeeked: Boolean;
function InternalGetToken: string;
begin
while Expr[P] in [#1..#32] do
Inc(P);
if Expr[P] = #0 then
begin
Result := #0;
Exit;
end;
case Expr[P] of
'+', '-', '*', '/', '^', '(', ')', ',', '=':
begin
Result := Expr[P];
Inc(P);
Exit;
end;
'>':
begin
if Expr[P+1] = '=' then
begin
Inc(P, 2);
Result := '>=';
Exit;
end;
Result := Expr[P];
Inc(P);
end;
'<':
begin
if Expr[P+1] = '>' then
begin
Inc(P, 2);
Result := '<>';
Exit;
end;
if Expr[P+1] = '=' then
begin
Inc(P, 2);
Result := '<=';
Exit;
end;
Result := Expr[P];
Inc(P);
end;
'!':
begin
if Expr[P+1] = '=' then
begin
Inc(P, 2);
Result := '!=';
Exit;
end;
Result := Expr[P];
Inc(P);
end;
end;
if Expr[P] in ['a'..'z','A'..'Z','_'] then
begin
Result := '';
while Expr[P] in ['a'..'z','A'..'Z','_', '0'..'9'] do
begin
Result := Result + Expr[P];
Inc(P);
end;
Result := LowerCase(Result);
Exit;
end;
if Expr[P] in ['0'..'9'] then
begin
Result := '';
while Expr[P] in ['0'..'9'] do
begin
Result := Result + Expr[P];
Inc(P);
end;
if Expr[P] = '.' then
begin
Result := Result + Expr[P];
Inc(P);
while Expr[P] in ['0'..'9'] do
begin
Result := Result + Expr[P];
Inc(P);
end;
end;
if Expr[P] in ['E', 'e'] then
begin
Result := Result + Expr[P];
Inc(P);
if Expr[P] in ['+', '-'] then
begin
Result := Result + Expr[P];
Inc(P);
end;
while Expr[P] in ['0'..'9'] do
begin
Result := Result + Expr[P];
Inc(P);
end;
end;
Exit;
end;
Error('unrecognized char for token: ' + Expr[P]);
end;
function PeekToken: string;
begin
if IsTokenPeeked then
Result := PeekedToken
else
begin
Result := InternalGetToken;
PeekedToken := Result;
IsTokenPeeked := True;
end;
end;
function GetToken: string;
begin
if IsTokenPeeked then
begin
Result := PeekedToken;
IsTokenPeeked := False;
end
else
Result := InternalGetToken;
end;
function EvalFactor: Single; forward;
function EvalPower: Single;
begin
Result := EvalFactor;
if PeekToken = '^' then
begin
GetToken;
Result := Power(Result, EvalPower);
end;
end;
function EvalMulDiv: Single;
begin
Result := EvalPower;
while True do
begin
if PeekToken = '*' then
begin
GetToken;
Result := Result * EvalPower;
end
else
if PeekToken = '/' then
begin
GetToken;
Result := Result / EvalPower;
end
else
Break;
end;
end;
function EvalAddSub: Single;
begin
if PeekToken = '-' then
begin
GetToken;
Result := - EvalMulDiv;
end
else
Result := EvalMulDiv;
while True do
begin
if PeekToken = '+' then
begin
GetToken;
Result := Result + EvalMulDiv;
end
else
if PeekToken = '-' then
begin
GetToken;
Result := Result - EvalMulDiv;
end
else
Break;
end;
end;
function EvalLogicRel: Single;
begin
Result := EvalAddSub;
if PeekToken = '>' then
begin
GetToken;
Result := Ord(Result > EvalLogicRel);
end
else
if PeekToken = '<' then
begin
GetToken;
Result := Ord(Result < EvalLogicRel);
end
else
if PeekToken = '=' then
begin
GetToken;
Result := Ord(Result = EvalLogicRel);
end
else
if (PeekToken = '<>') or (PeekToken = '!=') then
begin
GetToken;
Result := Ord(Result <> EvalLogicRel);
end
end;
function EvalLogicAndOr: Single;
begin
Result := EvalLogicRel;
while True do
begin
if PeekToken = 'and' then
begin
GetToken;
Result := Ord((Result <> 0) and (EvalLogicRel <> 0));
end
else
if PeekToken = 'or' then
begin
GetToken;
Result := Ord((Result <> 0) or (EvalLogicRel <> 0));
end
else
Break;
end;
end;
function EvalFuncCall(Name: string; Params: TList): Single;
var
Count: Integer;
List: array of Double;
i: Integer;
function R(X: Integer): Single;
begin
Result := Single(Params[i]);
end;
function GetMax: Double;
var
i: Integer;
begin
Result := List[0];
for i:=1 to Count-1 do
if List[1] > Result then
Result := List[1];
end;
function GetMin: Double;
var
i: Integer;
begin
Result := List[0];
for i:=1 to Count-1 do
if List[1] < Result then
Result := List[1];
end;
function GetBetween: Double;
begin
Result := Ord((List[0] >= List[1]) and (List[0] <= List[2]) or
(List[0] >= List[2]) and (List[0] <= List[1]));
end;
function GetIf: Double;
begin
if List[0] <> 0 then
Result := List[1]
else
Result := List[2];
end;
begin
Result := 0;
Name := LowerCase(Name);
Count := Params.Count;
SetLength(List, Count);
for i:=0 to Params.Count-1 do
List[i] := Single(Params[i]);
if (Name = 'sin') and (Count = 1) then
Result := Sin(List[0])
else if (Name = 'cos') and (Count = 1) then
Result := Cos(List[0])
else if (Name = 'tan') and (Count = 1) then
Result := Tan(List[0])
else if (Name = 'exp') and (Count = 1) then
Result := Exp(List[0])
else if (Name = 'log10') and (Count = 1) then
Result := Log10(List[0])
else if (Name = 'abs') and (Count = 1) then
Result := Abs(List[0])
else if (Name = 'stddev') and (Count >= 1) then
Result := StdDev(List)
else if (Name = 'variance') and (Count >= 1) then
Result := Variance(List)
else if ((Name = 'average') or (Name = 'mean') or (Name = 'avg'))
and (Count >= 1) then
Result := Mean(List)
else if (Name = 'max') and (Count >= 1) then
Result := GetMax
else if (Name = 'min') and (Count >= 1) then
Result := GetMin
else if (Name = 'between') and (Count = 3) then
Result := GetBetween
else if (Name = 'if') and (Count = 3) then
Result := GetIf
else
begin
if Assigned(FuncCallHandler) then
try
Result := FuncCallHandler(Name, List);
except
on EAbort do Error('function not defined: ' + Name);
else
raise;
end
else
Error('function not defined: ' + Name);
end;
end;
function EvalVariable(Name: string): Double;
var
i: Integer;
begin
for i:=0 to High(Variables) do
if AnsiCompareText(Variables[i], Name) = 0 then
begin
Result := VarValues[i];
Exit;
end;
Result := 0;
Error('variable not defined: ' + Name);
end;
function EvalExpr: Single;
begin
Result := EvalLogicAndOr;
end;
function EvalFactor: Single;
var
V: string;
Values: TList;
begin
case PeekToken[1] of
'(':
begin
GetToken;
Result := EvalExpr;
if GetToken <> ')' then
Error('unmatched right parenthese ")"');
Exit;
end;
'A'..'Z','a'..'z','_':
begin
V := GetToken;
if PeekToken = '(' then // function must be processed
begin
GetToken;
Values := TList.Create;
try
if PeekToken = ')' then // Empty function is an exceptional parse
GetToken
else
begin
while True do
begin
Values.Add(Pointer(EvalExpr));
case GetToken[1] of
')': Break;
',': ;
else Error('function call missing "," or ")"');
end;
end;
end;
Result := EvalFuncCall(V, Values);
finally
Values.Free;
end;
end
else
Result := EvalVariable(V);
Exit;
end;
'0'..'9':
begin
Result := StrToFloat(GetToken);
Exit;
end;
end;
Result := 0;
Error('unexpected token during getting factor: ' + PeekToken);
end;
begin
if Expr = '' then
Error('empty expression');
P := 1;
IsTokenPeeked := False;
Result := 0;
try
Result := EvalExpr;
except
on EConvertError do Error('conversion error');
on EZeroDivide do Error('divide by zero error');
else
raise;
end;
end;
procedure TestParser;
var
S: string;
begin
while True do
begin
ReadLn(S);
if S = '' then
Halt;
try
WriteLn(EvaluateExpr(S, ['x','y','z'], [1,2,3]));
except
on E: EParseError do
WriteLn('Error: ' + E.Message);
else
raise;
end;
end;
end;
function EvaluateToStr(Text: string; const Variables: array of string; const VarValues: array of Double): string;
begin
Result := '';
if Text = '' then
Exit;
try
Result := FloatToStr(EvaluateExpr(Text, Variables, VarValues));
except
on EConvertError do
Result := '數值格式錯誤';
on E: EParseError do
Result := '編譯錯誤：' + E.Message;
else
raise;
end;
end;
end.
--
Chaos is the best description of the constant state of human society.
Therefore, dynamic balance is required for us to to survive when vital fault
occurrs. So in the society, we don't chase for peace and order, but existence
and survival, instead.
--
※ 發信站: 批踢踢實業坊(ptt.twbbs.org)
◆ From: 140.112.3.12