Program RPN;
Uses CRT;
Type
CStack = record
StP: integer;
Elements: array [0..80] of char;
end;
DStack = record
StP: integer;
Elements: array [0..80] of double;
end;
CharSet = set of char;
Values = array ['A'..'Z'] of double;
Const
Operands: CharSet = ['A'..'Z'];
Operations: CharSet = ['(', ')', '+', '-', '*', '/', '^'];
Digits: CharSet = ['0'..'9', '.'];
Procedure InitCStack(var s: CStack);
begin
s.StP := -1;
end;
Procedure InitDStack(var s: DStack);
begin
s.StP := -1;
end;
Function PushC(var s: CStack; c: char): boolean;
begin
PushC := false;
if s.StP = 80 then exit;
inc(s.StP);
s.Elements[s.StP] := c;
if s.StP > 0 then
if (s.Elements[s.StP - 1] = '(') and (s.Elements[s.StP] = ')') then dec(s.StP, 2);
PushC := true;
end;
Function PushD(var s: DStack; d: double): boolean;
begin
PushD := false;
if s.StP = 80 then exit;
inc(s.StP);
s.Elements[s.StP] := d;
PushD := true;
end;
Function PopC(var s: CStack): char;
begin
PopC := #0;
if s.StP = -1 then exit;
PopC := s.Elements[s.StP];
dec(s.StP);
end;
Function PopD(var s: DStack): double;
begin
PopD := 0;
if s.StP = -1 then exit;
PopD := s.Elements[s.StP];
dec(s.StP);
end;
Function Priority(Op: char):integer;
begin
if Op = '(' then Priority := 0
else if Op = ')' then Priority := 1
else if Op = '+' then Priority := 2
else if Op = '-' then Priority := 2
else if Op = '*' then Priority := 3
else if Op = '/' then Priority := 3
else if Op = '^' then Priority := 4
else Priority := -1
end;
Function TransformToRPN(var expression, operandslist: string): integer;
var
s: CStack;
i, j, c: integer;
RPN, dop: string;
ch, ch1: char;
prevoperand: boolean;
d: double;
begin
InitCStack(s);
RPN := '';
operandslist := '';
TransformToRPN := 0;
i := 1;
prevoperand := false;
while i <= length(expression) do
begin
ch := upcase(expression[i]);
if ch in Operands then
begin
if prevoperand then
begin
TransformToRPN := i;
exit;
end;
if pos(ch, operandslist) = 0 then
operandslist := operandslist + ch;
RPN := RPN + ch;
prevoperand := true;
end
else if ch in Digits then
begin
j := i;
while (expression[i] in Digits) and (i <= length(expression)) do
inc(i);
if prevoperand then
begin
TransformToRPN := j;
exit;
end;
dop := copy(expression, j, i-j);
val(dop, d, c);
if c <> 0 then
begin
TransformToRPN := j + c - 1;
exit;
end;
RPN := RPN + '(' + dop + ')';
dec(i);
prevoperand := true;
end
else if ch in Operations then
begin
if (not prevoperand) and (ch <> '(') then
begin
TransformToRPN := i;
exit;
end;
if Priority(ch) = 0 then PushC(s, ch)
else if s.StP = -1 then PushC(s, ch)
else if Priority(s.Elements[s.StP]) < Priority(ch) then PushC(s,ch)
else
begin
while (Priority(s.Elements[s.StP]) >= Priority(ch)) and
(s.StP > -1) do
begin
ch1 := PopC(s);
if ch1 <> '(' then RPN := RPN + ch1;
end;
PushC(s, ch);
end;
if ch = ')' then prevoperand := true
else prevoperand := false;
end
else
begin
TransformToRPN := i;
exit;
end;
inc(i);
end;
while s.StP > -1 do
begin
ch := PopC(s);
if ch <> ')' then RPN := RPN + ch;
end;
expression := RPN;
end;
Function CalculateRPNExpression(RPN: string; OpValues: Values): double;
var
s: DStack;
d, d1: double;
i, j: integer;
ch: char;
dop: string;
begin
InitDStack(s);
i := 1;
while i <= length(RPN) do
begin
ch := RPN[i];
if ch = '(' then
begin
j := i;
while RPN[j] <> ')' do inc(i);
dop := copy(RPN, j+1, i-j-1);
val(dop, d, j);
PushD(s, d);
end
else if ch in Operands then
PushD(s, OpValues[ch])
else if ch in Operations then
begin
d := PopD(s);
d1 := PopD(s);
if ch = '+' then d := d1 + d
else if ch = '-' then d := d1 - d
else if ch = '*' then d := d1 * d
else if ch = '/' then d := d1 / d
else if ch = '^' then d := exp(d*ln(d1));
PushD(s, d);
end;
inc(i);
end;
CalculateRPNExpression := PopD(s);
end;
Var
ch, ch1: char;
Expression, RPNExpression, OperandsList: string;
i: integer;
OperandsValues: Values;
Begin
repeat
clrscr;
gotoxy(1,1);
writeln('1. Вычислить выражение.');
writeln('2. Выход.');
writeln('Введите свой выбор (1-2).');
ch := readkey;
if ch = #0 then ch1 := readkey;
if ch = '1' then
begin
clrscr;
gotoxy(1,1);
writeln('Введите выражение');
readln(Expression);
RPNExpression := Expression;
i := TransformToRPN(RPNExpression, OperandsList);
if i = 0 then
begin
writeln('Выражение в ОПЗ:');
writeln(RPNExpression);
for i := 1 to length(OperandsList) do
if OperandsList[i] in Operands then
begin
write('Введите значение ' + OperandsList[i] + ' ');
readln(OperandsValues[OperandsList[i]]);
end;
write('Значение выражения ');
writeln(CalculateRPNExpression(RPNExpression, OperandsValues):11:4);
end
else
begin
writeln('Ошибка в выражении.');
insert('?', RPNExpression, i);
writeln(RPNExpression);
end;
writeln('Для продолжения натисните пимпу.');
ch1 := readkey;
if ch1 = #0 then ch1 := readkey;
end;
until ch = '2';
End.
). А вообще компоненты-парсеры формул есть.
