Преобразование выражения к Обратной Польской Нотации
Материал из DRKB
{ **** UBPFD *********** by kladovka.net.ru ****
>> Преобразование выражения к Обратной Польской Нотации
Для работы функции необходимо определить тип:
type
TOperList = array of WideString;
Параметром функции служит массив из переменных и операторов.
Результат - массив из переменных и операторов
Зависимости: SysUtils
Автор: avr555, avr555@mail.ru, ICQ:15782989
Copyright: Переделано с http://algolist.manual.ru/syntax/revpn.php
Дата: 26 мая 2002 г.
********************************************** }
type
TOperList = array of WideString;
function ConvertToRPN(AStr: TOperList): TOperList;
var
i, k: Integer;
Stack: TOperList; // Stack
AResult: TOperList; // Tmp for result
function Prior(AOper: WideString): Integer;
begin
{ Приоритет операции:
NOT - 8
унарный "-" - 7
"*", "/" - 6
"+", "-" - 5
">", "<", "=",
"<>", ">=",
"<=" - 4
"AND" - 3
"OR" - 2
"(", ")" - 1
}
AOper := Trim(AOper);
Result := -1;
if AOper = 'NOT' then Result := 8;
if (AOper = '*') or (AOper = '/') then Result := 6;
if (AOper = '+') or (AOper = '-') then Result := 5;
if (AOper = '>') or (AOper = '<') or (AOper = '<>') or (AOper = '>=')
or (AOper = '<=') or (AOper = '=') then Result := 4;
if AOper = 'AND' then Result := 3;
if AOper = 'OR' then Result := 2;
if (AOper = '(') or (AOper = ')') then Result := 1;
end;
procedure AddToStack(AOper: WideString);
begin
{ Добавление элементы в стек }
SetLength(Stack, High(Stack) + 2);
Stack[High(Stack)] := AOper;
end;
procedure AddToResult(AOper: WideString);
begin
SetLength(AResult, High(AResult) + 2);
AResult[High(AResult)] := AOper;
end;
begin
{ Конвертирование строку в Обратную Польскую Нотацию
Возвращает - массив
Алгоритм:
а) если стек пуст, то опеpация из входной стpоки пеpеписывается в стек;
б) опеpация выталкивает из стека все опеpации с большим или pавным
пpиоpитетом в выходную стpоку;
в) если очеpедной символ из исходной стpоки есть откpывающая скобка,
то он пpоталкивается в стек;
г) закpывающая кpуглая скобка выталкивает все опеpации из стека до
ближайшей откpывающей скобки, сами скобки в выходную стpоку не
пеpеписываются, а уничтожают дpуг дpуга.
}
Result := nil;
AResult := nil;
i := 0;
while i <= High(AStr) do
begin
if Prior(AStr[i]) = -1 then // Значит просто переменная
AddToResult(AStr[i])
else // Операции
begin
if High(Stack) = -1 then {a}
AddToStack(AStr[i])
else
begin
if AStr[i] = '(' then {в}
AddToStack(AStr[i])
else
begin
if AStr[i] = ')' then {г}
begin
k := High(Stack);
while (k >= 0) and (Stack[k] <> '(') do
begin
AddToResult(Stack[k]);
SetLength(Stack, High(Stack)); // Удаляем элемент из стека
k := k - 1;
end;
// Удаляем открывающуюся скобку
SetLength(Stack, High(Stack)); // Удаляем элемент из стека
end
else
begin
k := High(Stack);
while (k >= 0) and (Prior(Stack[k]) >= Prior(AStr[i])) do {б}
begin
AddToResult(Stack[k]);
SetLength(Stack, High(Stack)); // Удаляем элемент из стека
k := k - 1;
end;
AddToStack(AStr[i]); // Если не скобка просто добавляем в стек
end;
end;
end;
end;
i := i + 1;
end; // while
// Сбрасываем все оставшееся из стека
for i := High(Stack) downto 0 do
begin
AddToResult(Stack[i]);
end;
Result := AResult;
end;
Пример использования:
procedure test;
var
s, s1: WideString;
tmp, rtmp: TOperList;
i: Integer;
begin
s := '(A+B)*(C+D)-E';
tmp := nil;
rtmp := nil;
for i := 1 to Length(S) do
begin
SetLength(tmp, High(tmp)+2);
tmp[High(tmp)] := S[i];
end;
rtmp := ConvertToRPN(tmp);
s1 := '';
for i := 1 to High(rtmp) do
begin
s1 := s1 + rtmp[i];
end;
end;
Author: avr555
ID: 04253