AISD_ReversePolishNotation

program PolishNotation;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    System.SysUtils;

Type
    PStack = ^TStackNode;
    TStackNode = Record
        StackPriority: Integer;
        Symbol: Char;
        Prev: PStack;
    End;

Const
    CorrectSymbolsVar = ['a'..'z'];
    CorrectSymbolsOper = ['*', '/', '-', '+', '^'];

Function InputStrExpr(): String;
Var
    StrExpr: String;
    OpeningBracketCounter, ClosingBracketCounter, OperatorCount, VariableCount, I: Integer;
    IsCorrect: Boolean;
Begin
    Repeat
        Writeln('Введите выражение, состоящее из однобуквенных перемменных (от a до z), знаков арифметических операций и круглых скобок. Выражение должно соответствовать правилам математики.');
        Readln(StrExpr);
        OpeningBracketCounter := 0;
        ClosingBracketCounter := 0;
        IsCorrect := True;
        if Length(StrExpr)<3 then
            IsCorrect := False;
        For I := 1 to Length(StrExpr) do
        Begin
            if IsCorrect And (StrExpr[I] In CorrectSymbolsVar) then
            Begin
                if (I>1) And (StrExpr[I-1] In CorrectSymbolsVar) then
                Begin
                    IsCorrect := False;
                    Writeln('В записи выражения допущена математическая ошибка.');
                End;
            End
            Else
                if IsCorrect And (StrExpr[I] In CorrectSymbolsOper) then
                Begin
                    if (I>1) And (StrExpr[I-1] In CorrectSymbolsOper) then
                    Begin
                        IsCorrect := False;
                        Writeln('В записи выражения допущена математическая ошибка.');
                    End;
                End
                Else
                    if IsCorrect And (StrExpr[I] = '(') then
                        Inc(OpeningBracketCounter)
                    Else
                        if IsCorrect And (StrExpr[I] = ')') then
                            Inc(ClosingBracketCounter)
                        Else
                            if IsCorrect then
                            Begin
                                Writeln('В выражении присутствуют недопустимые символы.');
                                IsCorrect := False;
                            End;
        End;
        if OpeningBracketCounter<>ClosingBracketCounter then
        Begin
            Iscorrect := False;
            Writeln('В записи выражения количество открывающих и закрывающих скобок не равны.');
        End;
    Until(IsCorrect);
    InputStrExpr := StrExpr;
End;

Procedure Output(Symbol:Char; StackTop: PStack; Const OutputString: String);
Var
    StackString: String;
Begin
    StackString := '';
    While(StackTop^.Prev<>Nil) Do
    Begin
        StackString := StackTop^.Symbol + StackString;
        StackTop := StackTop^.Prev;
    End;
    Writeln (Symbol,'                             ', StackString, '                                           ', OutputString);
End;

Procedure CheckPriority(Var StackTop: PStack; RelativePriority: Integer; Symbol: Char; Var OutputString: String);
Var
    NewStackTop: PStack;
Begin
    while (StackTop^.Prev <> Nil) And (((Symbol <> ')') And (StackTop^.StackPriority >= RelativePriority)) Or ((Symbol = ')') And (StackTop^.Symbol <>'('))) do
    Begin
        if StackTop^.Symbol <> '(' then
            OutputString := OutputString + StackTop^.Symbol;
        NewStackTop := StackTop^.Prev;
        Dispose(StackTop);
        StackTop := NewStackTop;
    End;
    if Symbol <> ')' then
    Begin
        New(NewStackTop);
        NewStackTop^.Symbol := Symbol;
        if Symbol = '^' then
            NewStackTop^.StackPriority := 5
        Else
            if Symbol = '(' then
                NewStackTop^.StackPriority := 0
            Else
                NewStackTop^.StackPriority := RelativePriority+1;
        NewStackTop^.Prev := StackTop;
        StackTop := NewStackTop;
    End
    Else
        if StackTop^.Symbol = '(' then
        Begin
            NewStackTop := StackTop^.Prev;
            Dispose(StackTop);
            StackTop := NewStackTop;
        End;

End;

Function ConvertRevPolNot(Const StrExpr: String; Var StackTop: PStack): String;
Var
    I: Integer;
    OutputString: String;
Begin
    OutputString := '';
    for I := 1 to Length(StrExpr) do
    Begin
        case StrExpr[I] of
            '+', '-': CheckPriority(StackTop, 1, StrExpr[I], OutputString);
            '*', '/': CheckPriority(StackTop, 3, StrExpr[I], OutputString);
            '^': CheckPriority(StackTop, 6, StrExpr[I], OutputString);
            'a'..'z': CheckPriority(StackTop, 7, StrExpr[I], OutputString);
            '(': CheckPriority(StackTop, 9, StrExpr[I], OutputString);
            ')': CheckPriority(StackTop, 0, StrExpr[I], OutputString);
        end;
        Output(StrExpr[I], StackTop, OutputString);
    End;
    CheckPriority(StackTop, 0, ')', OutputString);
    Output(' ', StackTop, OutputString);
    ConvertRevPolNot := OutputString;
End;

Function CalculateRang (Const RevPolNot: String): Integer;
Var
    OperatorCount, VariableCount, I: Integer;
Begin
    OperatorCount := 0;
    VariableCount := 0;
    For I := 1 to Length(RevPolNot) do
    Begin
        if (RevPolNot[I] In CorrectSymbolsVar) then
            Inc(VariableCount)
        Else
            if (RevPolNot[I] In CorrectSymbolsOper) then
                Inc(OperatorCount);
    End;
    CalculateRang := VariableCount-OperatorCount;
End;

Var
    StrExpr, RevPolNot: String;
    StackHead: PStack;
begin
    StrExpr := InputStrExpr();
    New(StackHead);
    Writeln('Символ                        Стек                                        Выходная строка');
    RevPolNot := ConvertRevPolNot(StrExpr, StackHead);
    Writeln('Выражение, записанное по обратной польской нотации:');
    Writeln (RevPolNot);
    Writeln('Ранг, полученной записи:');
    Writeln(CalculateRang(RevPolNot));
    Readln
end.