:: Pascal Page :: Обpатная польская нотация

Обpатная польская нотация

Обpатная польская нотация
Программы преобразования: №1 / №2 (ООП) / №3 (Массив)

Обpатная польская нотация

Обpатная польская нотация использyется для вычисления аpифметических выpажений. Для пеpевода в нее необходим стек аpифметических опеpаций.

Алгоpитм пеpевода пpоизвольного выpажения в Обратную Польскую Нотацию очень пpост:

Выpажение сканиpyется слева напpаво, пpи этом pазбиваясь на токены - числа и знаки аpифметических опеpаций.

Если очеpедной токен - число, не глядя пишем его в выходнyю стpокy. Иначе, выталкиваем из стека и пишем в выходнyю стpокy все опеpации с пpиоpитетом выше или pавным текyщемy (тогда выполнение опеpаций с одинаковым пpиоpитетом бyдет пpоизводиться слева напpаво, т.е. как все мы пpивыкли, да и его глyбина yменьшится), а самy опеpацию пихаем в стек.
Левая скобка всегда пишется в стек (ее пpиоpитет - самый низкий).
Пpавая скобка выталкивает из стека все опеpации вплоть до левой скобки включительно, сама она в стек не пишется.

Когда достигнyт конец входного выpажения, пpосто выталкиваем из стека все что в нем есть.

Пpимеp: (2+3)*4+5

левая скобка - пихаем в стек
2 - пишем в выходнyю стpокy
+ - стек пyст, поэтомy ничего не достаем, а напpотив, пихаем плюс
3 - пишем в выходнyю стpокy
пpавая скобка - выталкиваем плюс и левyю скобкy
* - стек снова пyст, пихаем yмножение
4 - пишем в выходнyю стpокy
+ - пpиоpитет yмножения - выше, поэтомy его достаем, а плюс - пихаем
5 - пишем в выходнyю стpокy
EOF - достаем из стека плюс

Имеем: 2 3 + 4 * 5 +

Обpатим внимание на следyющее:

Вместо записи в выходнyю стpокy можно тyт же вычислять выpажение, для этого необходим еще один стек
Скобки в выходнyю стpокy не пишyтся, так как их пpиоpитет yчитывается автоматически; однако их баланс легко пpовеpяется.

Программа №1

Вот программа, написанная по приведенному выше алгоритму...

type
  TokenType =
    (tkOpen,
     tkPlus, tkMinus,
     tkMult, tkDiv,
     tkClose,
     tkNumber );

const
  chars: array[TokenType] of char =
    ( '(', '+', '-', '*', '/', ')', ' ' );
  priority: array[TokenType] of byte =
    (0, 1, 1, 2, 2, 5, 10);

type
  TType = TokenType;

  PTItem = ^TItem;
  TStack = PTItem;
  TItem =
    record
      info: TType;
      next: PTItem;
    end;

procedure initStack(var s: TStack);
begin
  s := nil
end;

function isEmpty(var s: TStack): boolean;
begin
  isEmpty := (s = nil)
end;

procedure pushStack(var s: TStack; T: TType);
var
  nItem: PTItem;
begin
  new(nItem);
  nItem^.next := s;
  nItem^.info := T;
  s := nItem;
end;

function topStack(var s: TStack): TType;
begin
  topStack := s^.info
end;

function popStack(var s: TStack): TType;
var ToDelete: PTItem;
begin
  if not isEmpty(s) then begin
    ToDelete := s;
    s := s^.next;
    popStack := ToDelete^.info;
    dispose(ToDelete)
  end;
end;


function getNextToken(var s, sT: string): TokenType;
begin
  case s[1] of
    '(', ')':
    begin
      case s[1] of
        '(': getNextToken := tkOpen;
        ')': getNextToken := tkClose;
      end;
      st := ''; delete(s, 1, 1)
    end;
    '-', '+', '*', '/':
    begin
      case s[1] of
        '+': getNextToken := tkPlus;
        '-': getNextToken := tkMinus;
        '*': getNextToken := tkMult;
        '/': getNextToken := tkDiv;
      end;
      st := s[1]; delete(s, 1, 1);
    end
    else begin
      st := '';
      while (s <> '') and (s[1] in ['0'..'9', '.']) do begin
        st := st + s[1];
        delete(s, 1, 1);
      end; { while }
      getNextToken := tkNumber
    end; { else }
  end { case }
end; { getNextToken }

const
  s: string = '2*(3+4)*5';
var
  sToken: string;
  nextToken, from: TokenType;
  sres: string;
  myStack: TStack;

function GetStack: TokenType;
var T: TokenType;
begin
  T := popStack(myStack);
  if T <> tkOpen then
    sres := sres + ' ' + chars[ T ];
  GetStack := T
end;

begin
  initStack(myStack);

  while s <> '' do begin
    nextToken := getNextToken(s, sToken);
    case nextToken of
      tkNumber:
        sres := sres + ' ' + sToken;
      tkOpen:
        pushStack(myStack, nextToken);
      tkClose:
        repeat
          from := GetStack
        until from = tkOpen;
      tkPlus, tkMinus,
      tkDiv, tkMult:
      begin
        while (not isEmpty(myStack)) and
              (priority[nextToken] <= priority[topStack(myStack)]) do
          GetStack;
        pushStack(myStack, nextToken);
      end;
    end { case }
  end; { while }

  while not isEmpty(myStack) do
    GetStack;

  writeln(sres);
end.

Программа №2 (ООП)

Еще одна версия решения (с использованием ООП - Объектно-Ориентированного Программирования.

Стек реализуется в виде объекта):

Type
  TokenType =
    (tkOpen, tkPlus, tkMinus, tkMult, tkDiv, tkClose, tkNumber);
  TType = TokenType;

Type
  PTNode = ^TNode;
  TNode = Record
    Data: TType;
    next: PTNode;
  End;

  TStack = Object
    Head: PTNode;

    Constructor Init;

    Procedure Push(T: TType);
    Function Pop: TType;
    Function Top: TType;

    Function Empty: Boolean;
  End;

(*
  TStack Definition
*)
constructor TStack.Init;
begin
  Head := nil
end;

procedure TStack.Push(T: TType);
var newNode: PTNode;
begin
  New(newNode);
  with newNode^ do begin
    next := Head;
    Data := T
  end;
  Head := newNode
end;

function TStack.Pop: TType;
var ToDelete: PTNode;
begin
  if not Empty then begin
    ToDelete := Head;
    Head := Head^.next;
    Pop := ToDelete^.Data;
    Dispose(ToDelete)
  end
end;

function TStack.Empty: Boolean;
begin
  Empty := (Head = nil)
end;

function TStack.Top: TType;
begin
  Top := Head^.Data
end;
(*
  End of TStack Definition
*)


const
  Chars: Array[TokenType] Of Char =
    ( '(', '+', '-', '*', '/', ')', ' ' );
  Priority: Array[TokenType] Of Byte =
    (0, 1, 1, 2, 2, 5, 10);


function getNextToken(var s, sT: string): TokenType;
const
  Brcks = ['(', ')'];
  Oprnd = ['+', '-', '*', '/'];
  ChSet = Brcks + Oprnd;

var i: TokenType;
begin
  if s[1] In ChSet then begin
    for i := Low(TokenType) to High(TokenType) do
      if s[1] = Chars[i] then begin
        getNextToken := i; Break
      end;

      if s[1] In Brcks then sT := ''
      else sT := s[1];
      
      Delete(s, 1, 1)
  end
  else begin
    sT := '';
    while (s <> '') and (s[1] in ['0'..'9', '.']) do begin
      sT := sT + s[1];
      Delete(s, 1, 1);
    end;
    getNextToken := tkNumber
  end;
end;


const
  s: String = {'(5-4)*2'}
              '2*(3+4)*5'
              {'3+4'};
var
  sToken, sRes: string;
  nextToken, From: TokenType;
  toknStack: TStack;

function GetStack: TokenType;
var T: TokenType;
begin
  T := toknStack.Pop;
  if T <> tkOpen then
    sRes := sRes + ' ' + Chars[ T ];
  GetStack := T
end;

begin
  toknStack.Init;

  while s <> '' do begin
    nextToken := getNextToken(s, sToken);
    case nextToken of
      tkNumber: sRes := sRes + ' ' + sToken;
      tkOpen  : toknStack.Push(nextToken);
      tkClose :
        repeat
          From := GetStack
        until From = tkOpen;
      tkPlus, tkMinus,
      tkDiv, tkMult:
        begin
          while (not toknStack.Empty) and
                (Priority[nextToken] <= Priority[toknStack.Top]) do
            GetStack;
          toknStack.Push(nextToken)
        end;
    end { case }
  end; { while }

  while not toknStack.Empty do
    GetStack;

  WriteLn(sRes)
end.

Программа №3 (Массив)

Реализация стека через массив. Логика программы не изменилась - изменился лишь способ реализации стека...

Type
  {Это все типы значений, допустимые при преобразовании}
  TokenType =
    (tkOpen, tkPlus, tkMinus, tkMult, tkDiv, tkClose, tkNumber);
  TType = TokenType;

{ Начало реализации стека }
const
  maxStack = 250; { макс. размер "стека" }
  currTop: Integer = 0;
var
  stArr: Array[1 .. maxStack] Of TType; { здесь будет сам "стек" }

{ Процедура "заталкивает" значение, передаваемое ей в стек и следит за
  его переполнением }
procedure Push(x: TType);
begin
  if currTop <> maxStack then begin { только если стек не переполнен }
    Inc(currTop); stArr[currTop] := x;
  end;
end;

{
  Эта функция "выталкивает из стека" очередное значение,
  опять же следя, чтобы не было "взятия" из пустого стека
}
function Pop: TType;
begin
  if currTop <> 0 then begin { только если стек не пуст }
    Pop := stArr[currTop]; Dec(currTop);
  end;
end;

{
  Функция копирует последнее занесенное в стек значение
  без "изъятия" его из стека
}
function Top: TType;
begin
  Top := stArr[currTop];
end;

{ Проверка "стека" на пустоту }
function Empty: Boolean;
begin
  Empty := (currTop = 0)
end;
{ Конец реализации стека }


{ Дальше - незначительные изменения }
const
  { символьные соответствия для каждого допустимого значения }
  Chars: Array[TokenType] Of Char =
    ( '(', '+', '-', '*', '/', ')', ' ' );
  {
    Приоритет операции - в порядке возрастания,
    т.е. у открывающей скобки - самый низкий, потом -
    сложение/вычитание и т.д. Порядок операций аналогичен
    порядку описания в типе TokenType
  }
  Priority: Array[TokenType] Of Byte =
    (0, 1, 1, 2, 2, 5, 10);


{ Функция берет из строки следующий элемент }
function getNextToken(var s, sT: string): TokenType;
const
  Brcks = ['(', ')'];
  Oprnd = ['+', '-', '*', '/'];
  ChSet = Brcks + Oprnd;

var i: TokenType;
begin
  if s[1] In ChSet then begin
    for i := Low(TokenType) to High(TokenType) do
      if s[1] = Chars[i] then begin
        getNextToken := i; Break
      end;

    if s[1] In Brcks then sT := ''
    else sT := s[1];
    
    Delete(s, 1, 1)
  end { if }
  else begin
    sT := '';
    while (s <> '') and (s[1] in ['0'..'9', '.']) do begin
      sT := sT + s[1];
      Delete(s, 1, 1);
    end;
    getNextToken := tkNumber
  end; { else }
end;


const
  s: String = {'(5-4)*2'}
              '2*(3+4)*5'
              {'3+4'};
var
  sToken, sRes: string;
  nextToken, From: TokenType;

{ эта функция была описана просто для улучшения читаемости кода }
function GetStack: TokenType;
var T: TokenType;
begin
  T := Pop;
  if T <> tkOpen then
    sRes := sRes + ' ' + Chars[ T ];
  GetStack := T
end;

begin
  while s <> '' do begin
    nextToken := getNextToken(s, sToken);
    case nextToken of
      tkNumber: sRes := sRes + ' ' + sToken;
      tkOpen  : Push(nextToken);
      tkClose :
        repeat
          From := GetStack
        until From = tkOpen;
      tkPlus, tkMinus,
      tkDiv, tkMult:
        begin
          while (not Empty) and
                (Priority[nextToken] <= Priority[Top]) Do
            GetStack;
          Push(nextToken)
        end;
    end { case }
  end; { while }

  while not Empty do
    GetStack;

  WriteLn(sRes)
end.