unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    mathexpr: TEdit;
    Button1: TButton;
    res: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

(********************************************************************)
//Использованные сокращения
//  expr = expression
//  sym = symbol
//  tab = table
//  prior = priority
//  ExprToOpn = Expression to OPN (ОПН - Обратная польская нотация)
(********************************************************************)

//Определение приоритета знака
function prior (sym: String): Shortint;
begin
  if sym[1] in ['/','*'] then
    Result := 2
  else
    if sym[1] in ['+','-'] then
      Result := 1
    else
      Result := -1;
end;

//Поиск конца стека
function stackend (tab: Variant; sym: Byte): Integer;
var
  i: Integer;
begin
  for i := 0 to 500  do
    if tab[i,sym] = '' then
      begin
        Result := i - 1;
          break;
      end;
end;

//Замена унарного минуса на букву 'm'
function delmin (expr: String): String;
var
  i: Integer;
begin
  for i := 1 to length(expr) do
    if (expr[i] = '-') and ((i = 1) or (expr[i - 1] = '(')) then
      expr[i] := 'm';
    Result := expr;
end;


//Перевод выражения в ОПН
function ExprToOpn(expr: String): String;
var
  i,outstr: Integer;
  tab: array of array of String;
begin
  expr := '(' + delmin(expr) + ')';
  SetLength(tab, length(expr), length(expr));
  outstr := 0;
  { Проверяем каждый символ в выражении, если символ не знак операции или скобки,
    то выводим его в выходную строку }
  for i := 1 to length(expr) do
    if not(expr[i] in ['+', '-', '*', '/', '(', ')']) then
      begin
        tab[outstr,0] := tab[outstr,0] + expr[i];
      end
    else
    { Если временнный стек пуст, то помещаем в
    него символ }
      if tab[0,1] = '' then
        begin
          tab[0,1] := expr[i];
          outstr := stackend(tab,0) + 1;
        end
        else
        { Если приоритет последнего символа в стеке меньше чем символ в
          выражении и не скобка, то помещаем его в стек }
          if (prior(tab[stackend(tab,1),1]) < prior(expr[i]))
          and (prior(expr[i]) <> -1) then
            begin
              tab[stackend(tab,1) + 1,1] := expr[i];
              outstr := stackend(tab,0) + 1;
            end
          else
          { Если приоритет последнего символа в стеке больше или
            равен символу в выражении и не скобка, то перемещаем символы из
            стека в выходную строку до тех пор, пока его приоритет не
            станет меньше или не станет скобкой }
            if (prior(tab[stackend(tab,1),1]) >= prior(expr[i]))
            and (prior(expr[i]) <> -1) then
              begin
                while (prior(tab[stackend(tab,1),1]) >= prior(expr[i]))
                and (prior(tab[stackend(tab,1),1]) <> -1) do
                  begin
                    tab[stackend(tab,0) + 1,0] := tab[stackend(tab,1),1];
                    tab[stackend(tab,1),1] := '';
                    if stackend(tab,1) < 0 then
                      break;
                  end;
                    { Когда последний символ в стеке станет меньше
                      или равен символу в выражении, вставляем символ из
                      выражения в выходную строку }
                    tab[stackend(tab,1) + 1,1] := expr[i];
                    outstr := stackend(tab,0) + 1;
            end
            else
           { Если символ открывающая скобка, то вставляем его в
             выходную строку }
                if expr[i] = '(' then
                  begin
                    tab[stackend(tab,1) + 1,1] := '(';
                    outstr := stackend(tab,0) + 1;
                end
                else
                { Если символ закрывающая скобка, то переносим символы из
                  стека в выходную строку до тех пор, пока не встретим
                  открывающую скобку, после чего уничтожаем её }
                  begin
                    if expr[i] = ')' then
                      while tab[stackend(tab,1),1] <> '(' do
                        begin
                          tab[stackend(tab,0) + 1,0] := tab[stackend(tab,1),1];
                          tab[stackend(tab,1),1] := '';
                        end;
                    tab[stackend(tab,1),1] := '';
                    outstr := stackend(tab,0) + 1;
                  end;
  { После прочтения всех символов выражения, переносим все знаки
    из стека в выходную строку }
  while stackend(tab,1) <> -1 do
    begin
      tab[stackend(tab,0) + 1,0] := tab[stackend(tab,1),1];
      tab[stackend(tab,1),1] := '';
    end;
    {Копируем выходную строку в результат}
  for i := 0 to stackend(tab,0) do
    begin
      Result := Result + ' ' + tab[i,0];
      tab[i,0] := '';
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  res.Text := ExprToOpn(mathexpr.Text);
end;

end.