Преобразование выражения к Обратной Польской Нотации

{ **** 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
Category:Алгоритмы
Category:Математика
Category:Работа с текстом