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

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

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

 

Для работы функции необходимо определить тип:

type

OperList = array of widestring;

 

Параметром функции служит массив из переменных и операторов.

Результат - массив из переменных и операторов

 

Зависимости: SysUtils

Автор:       avr555, avr555@mail.ru, ICQ:15782989

Copyright:   Переделано с http://algolist.manual.ru/syntax/revpn.php

Дата:        26 мая 2002 г.

********************************************** }

 

function ConvertToRPN(AStr:OperList):OperList;

var

i,k:integer;

Stack : OperList; //Stack

AResult : OperList; //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;

 

 

 

 

Пример использования:

Code:

procedure test;

var

s,s1:widestring;

tmp,

rtmp : OperList;

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;

 

©Drkb::04253