nielsie95
2009-10-27 16:07:31
Hey,
This is a Math Expression Evaluator using the Shunting Yard algorithm to convert expressions to Reverse Polish Notation for easier solving. It supports +, -, *, / and ^.
Nielsie95
This is a Math Expression Evaluator using the Shunting Yard algorithm to convert expressions to Reverse Polish Notation for easier solving. It supports +, -, *, / and ^.
program Shunting_Yard;
const
Line = '(1 + (1/(10 ^ 11)))^(10 ^ 11)';
type
EToken = (tUnkown, tNumber, {tVar,} tPower, tMultiply, tDivide, tAdd, tSubtract, tLeftParenthesis, tRightParenthesis);
EAssociative = (asUnknown, asLeft, asRight);
{.$DEFINE INT_VERSION}
function OperatorToString(Token: EToken): string;
begin
case Token of
tMultiply: Result := '*';
tDivide: Result := '/';
tAdd: Result := '+';
tSubtract: Result := '-';
tPower: Result := '^';
else
Result := #0;
end;
end;
function SY_GetPrecedence(Operator: EToken): Byte;
begin
case Operator of
tPower: Result := 3;
tMultiply,
tDivide: Result := 2;
tAdd,
tSubtract: Result := 1;
else
begin
WriteLn('Uh Oh ' + IntToStr(Integer(Operator)));
Exit;
end;
end;
end;
function SY_GetAssociative(Operator: EToken): EAssociative;
begin
Result := asUnknown;
case Operator of
tMultiply,
tDivide,
tAdd,
tSubtract: Result := asLeft;
tPower: Result := asRight;
else
begin
WriteLn('Uh Oh ' + IntToStr(Integer(Operator)));
Exit;
end;
end;
end;
function SY_ReadToken(var Pos: Integer; Line: string; out TokenString: string; out Token: EToken): Boolean;
var
Len: Integer;
begin
Result := False;
if (Pos < 1) then
Pos := 1;
TokenString := '';
Token := tUnkown;
Line := Line + #0;
Len := Length(Line);
while (Pos <= Len) do
begin
case Line[Pos] of
{'a'..'z', 'A'..'Z':
begin
TokenString := Line[Pos];
Token := tVar;
while (Pos < Len) do
begin
Inc(Pos);
case Line[Pos] of
'a'..'z', 'A'..'Z':
begin
TokenString := TokenString + Line[Pos];
Continue;
end;
else
Break;
end;
end;
Break;
end;}
'0'..'9':
begin
TokenString := Line[Pos];
Token := tNumber;
while (Pos < Len) do
begin
Inc(Pos);
case Line[Pos] of
{$IFNDEF INT_VERSION}'.',{$ENDIF}
'0'..'9':
begin
TokenString := TokenString + Line[Pos];
Continue;
end;
else
Break;
end;
end;
Break;
end;
'^':
begin
TokenString := '^';
Token := tPower;
Inc(Pos);
Break;
end;
'*':
begin
TokenString := '*';
Token := tMultiply;
Inc(Pos);
Break;
end;
'/':
begin
TokenString := '/';
Token := tDivide;
Inc(Pos);
Break;
end;
'+':
begin
TokenString := '+';
Token := tAdd;
Inc(Pos);
Break;
end;
'-':
begin
TokenString := '-';
Token := tSubtract;
Inc(Pos);
Break;
end;
'(':
begin
TokenString := '(';
Token := tLeftParenthesis;
Inc(Pos);
Break;
end;
')':
begin
TokenString := ')';
Token := tRightParenthesis;
Inc(Pos);
Break;
end;
end;
Inc(Pos);
end;
Result := (Token <> tUnkown);
end;
function Shunting_Yard(Line: string): string;
var
Token: EToken;
TokStr: string;
Pos, Presedence: Integer;
Associative: ShortInt;
OpStack: array[0..255] of EToken;
StackLen: Byte;
begin
StackLen := 0;
while SY_ReadToken(Pos, Line, TokStr, Token) do
begin
case Token of
tNumber: Result := Result + TokStr + ' ';
tPower,
tMultiply,
tDivide,
tAdd,
tSubtract:
begin
if (StackLen > 0) then
begin
case SY_GetAssociative(Token) of
asLeft: Associative := 0;
asRight: Associative := -1;
else
begin
WriteLn('wat.');
Exit;
end;
end;
Presedence := SY_GetPrecedence(Token);
while (StackLen > 0) and (OpStack[StackLen] <> tLeftParenthesis) do
if (Presedence <= SY_GetPrecedence(OpStack[StackLen]) + Associative) then
begin
Result := Result + OperatorToString(OpStack[StackLen]) + ' ';
Dec(StackLen);
end
else
Break;
end;
Inc(StackLen);
OpStack[StackLen] := Token;
end;
tLeftParenthesis:
begin
Inc(StackLen);
OpStack[StackLen] := tLeftParenthesis;
end;
tRightParenthesis:
begin
while (StackLen > 0) and (OpStack[StackLen] <> tLeftParenthesis) do
begin
Result := Result + OperatorToString(OpStack[StackLen]) + ' ';
Dec(StackLen);
end;
if (StackLen = 0) or (OpStack[StackLen] <> tLeftParenthesis) then
begin
WriteLn('hmm');
Exit;
end;
Dec(StackLen);
end;
end;
end;
while (StackLen > 0) do
begin
if (OpStack[StackLen] = tLeftParenthesis) then
begin
Writeln('nono!');
Exit;
end;
Result := Result + OperatorToString(OpStack[StackLen]) + ' ';
Dec(StackLen);
end;
Result := Trim(Result);
end;
function SolveRVP(RVP: string): {$IFDEF INT_VERSION}Int64{$ELSE}Extended{$ENDIF};
var
i, Len: Integer;
Input: TStringArray;
Stack: array[0..255] of {$IFDEF INT_VERSION}Int64{$ELSE}Extended{$ENDIF};
StackLen: Byte;
begin
Result := 0;
Input := Explode(' ', RVP);
Len := High(Input);
if (Len < 0) then
Exit;
StackLen := 0;
for i := 0 to Len do
begin
case Input[i] of
'-',
'+':
begin
if (StackLen < 1) then
begin
WriteLn('huh ---?!');
Exit;
end;
case Input[i] of
'+':
if (StackLen > 1) then
begin
Stack[StackLen - 1] := Stack[StackLen - 1] + Stack[StackLen];
Dec(StackLen);
end;
'-':
if (StackLen = 1) then
Stack[1] := -Stack[1]
else
begin
Stack[StackLen - 1] := Stack[StackLen - 1] - Stack[StackLen];
Dec(StackLen);
end;
end;
end;
'*',
'/',
'^':
begin
if (StackLen < 2) then
begin
WriteLn('huh?!');
Exit;
end;
case Input[i] of
'*': Stack[StackLen - 1] := Stack[StackLen] * Stack[StackLen - 1];
{$IFDEF INT_VERSION}
'/': Stack[StackLen - 1] := Stack[StackLen - 1] div Stack[StackLen];
'^': Stack[StackLen - 1] := Round(IntPow(Stack[StackLen - 1], Stack[StackLen]));
{$ELSE}
'/': Stack[StackLen - 1] := Stack[StackLen - 1] / Stack[StackLen];
'^': Stack[StackLen - 1] := Pow(Stack[StackLen - 1], Stack[StackLen]);
{$ENDIF}
end;
Dec(StackLen);
end;
else
begin
try
Inc(StackLen);
{$IFDEF INT_VERSION}
Stack[StackLen] := StrToInt64(Input[i]);
{$ELSE}
Stack[StackLen] := StrToFloat(Input[i]);
{$ENDIF}
except
WriteLn('pff');
Exit;
end;
end;
end;
end;
if (StackLen = 1) then
Result := Stack[1]
else
WriteLn('arggg');
end;
var
sy: string;
begin
sy := Shunting_Yard(Line);
WriteLn(sy);
WriteLn(SolveRVP(sy));
end.
Nielsie95