Poland

program PolNotation;

uses
  System.SysUtils;

Type
    TPStack = ^TStackElem;
    TStackElem = Record
        StackPriority: Integer;
        Symbol: Char;
        Next: TPStack;
    End;

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

Procedure CheckPriority(Var StackTop: TPStack; RelativePriority: Integer; Symbol: Char; Var OutputString: String);
Var
    NewStackTop: TPStack;
Begin
    while (StackTop^.Next <> Nil) And (((Symbol <> ')') And (StackTop^.StackPriority >= RelativePriority)) Or ((Symbol = ')') And (StackTop^.Symbol <>'('))) do
    Begin
        if StackTop^.Symbol <> '(' then
            OutputString := OutputString + StackTop^.Symbol;
        NewStackTop := StackTop^.Next;
        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^.Next := StackTop;
        StackTop := NewStackTop;
    End
    Else
        if StackTop^.Symbol = '(' then
        Begin
            NewStackTop := StackTop^.Next;
            Dispose(StackTop);
            StackTop := NewStackTop;
        End;

End;

Procedure OutputInfo(Symbol : Char; StackTop : TPStack; OutputString : String);
Var
    StackString : String;
Begin
    StackString := '';
    Write(Symbol + '            ');
    while StackTop <> Nil do
    Begin
        StackString := StackTop^.Symbol + StackString;
        StackTop := StackTop^.Next;
    End;
    Write(StackString);
    Write('                            ');
    Writeln(OutputString);


End;

Function ConvertRevPolNot(Const StrExpr: String; Var StackTop: TPStack): 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;
        OutputInfo(StrExpr[I], StackTop, OutputString);
    End;
    CheckPriority(StackTop, 0, ')', OutputString);
    ConvertRevPolNot := OutputString;
End;

Function CalculateRank(Expression : String) : Integer;
Const
    SymbolsSet = ['a'..'z'];
    SignSet = ['*', '/', '-', '+', '^'];
Var
    I, Rank : Integer;
Begin
    Rank := 0;
    for I := 1 to Length(Expression) do
        if Expression[I] in SymbolsSet then
            Inc(Rank)
        Else
            Dec(Rank);
    Result := Rank;
End;

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