Построение бинарного дерева из формулы (Pascal)

[Sibedir]

Готово

type
  PNode = ^TNode;
  TNode = record
    Data: Char;
    Parent: PNode;
    Left, Right: PNode;
  end;

  TCharType = (chtTerm, chtZnak, chtSpace, chtNil, chtError);

procedure Error (Mes: String);
begin
  WriteLn (Mes);
  ReadLn;
  Halt;
end;

procedure ErrorInPosition (Pos: Integer);
begin
  Error ('Error in ' + IntToStr(Pos) + ' position');
end;

function CharType (const ch: Char): TCharType;
begin
  case ch of
    '0'..'9'         : Result := chtTerm ;
    '+', '-', '*'    : Result := chtZnak ;
    #9, #10, #13, ' ': Result := chtSpace;
    #0               : Result := chtNil  ;
  else
    Result := chtError;
  end;
end;

function ZnakVes (const ch: Char): Byte;
begin
  case ch of
    '+', '-': Result := 1;
    '*'     : Result := 2;
  else
    Error ('Invalid argument in ZnakVes (' + ch + ')');
  end;
end;

function NewNode (const ch: Char): PNode;
begin
  New (Result);
  with Result^ do begin
    Data   := ch;
    Parent := nil;
    Left   := nil;
    Right  := nil;
  end;
end;

function ReadBuf (buf: String): PNode;
var
  Cur, New: PNode;
  i, Count, ves: Integer;
  ch: Char;
  Ojid {признак ожидания}, cht: TCharType;
begin
  // подготовка
  Cur := NewNode (#0); // создаем пустой узел, делаем его текущим
  Ojid := chtTerm; // ожидаем терминал

  Count := Length (buf);
  for i := 1 to Count do begin
    ch := buf[i]; // читаем очеродной символ
    cht := CharType (ch); // определяем тип символа
    case cht of
      chtTerm: begin // если текущий символ - ТЕРМИНАЛ
        if Ojid <> cht then ErrorInPosition (i);  // если тип текущего символа не совпадает с ожиданием
        Cur^.Data := ch; // записываем в текущий узел терминал
        Ojid := chtZnak; // ожидаем знак
      end;
      chtZnak: begin // если текущий символ - ЗНАК
        if Ojid <> cht then ErrorInPosition (i);  // если тип текущего символа не совпадает с ожиданием
        while Cur^.Parent <> nil do begin // пока не достигли верха
          ves := ZnakVes (ch); // определяем вес текущего знака
          if ZnakVes (Cur^.Parent^.Data) >= ves then // если вес родительского узла не меньше чем вес текущего знака
            Cur := Cur^.Parent // всплываем выше
          else begin
            Break; // выходим из цикла
          end;
        end;
        New := NewNode (ch); // новый узел-знак
        if Cur^.Parent <> nil then begin // если мы не на самом верху
          // подключаемся к родителю
          New^.Parent := Cur^.Parent;
          New^.Parent^.Right := New;
        end;
        // внедряем новый узел между текущим узлом и его родителем
        Cur^.Parent := New;
        New^.Left := Cur;
        // создаем пустой узел справа от нового и делаем его текущим
        New^.Right := NewNode (#0);
        Cur := New^.Right;
        Cur^.Parent := New;

        Ojid := chtTerm; // ожидаем терминал
      end;
      chtError, chtNil: ErrorInPosition (i);  // если текущий символ НЕДОПУСТИМ
    end;
  end;

  // поднимаемся на самый верх
  while Cur^.Parent <> nil do Cur := Cur^.Parent;
  Result := Cur;
end;

function GetFormula (ANode: PNode): String;
var
  ch: Char;
  cht: TCharType;
  l, r: String;
begin
  if ANode = nil then
    Error ('Invalid argument in GetFormula (nil)')
  else with ANode^ do begin
    ch := Data;
    cht := CharType (ch);
    case cht of
      chtTerm: Result := ch;
      chtZnak: begin
        l := GetFormula (Left);
        r := GetFormula (Right);
        case ch of
          '+', '-': Result := l + ' ' + ch + ' ' + r;
          '*'     : Result := l + ch + r;
        else
          Error ('Invalid argument in GetFormula (' + ch + ')');
        end;
      end;
      else Error ('Invalid argument in GetFormula (' + ch + ')')
    end;
  end;
end;

function CalcFormula (ANode: PNode): Integer;
var
  ch: Char;
  cht: TCharType;
  l, r: Integer;
begin
  if ANode = nil then
    Error ('Invalid argument in CalcFormula (nil)')
  else with ANode^ do begin
    ch := Data;
    cht := CharType (ch);
    case cht of
      chtTerm: Result := Ord(ch) - Ord('0');
      chtZnak: begin
        l := CalcFormula (Left);
        r := CalcFormula (Right);
        case ch of
          '+': Result := l + r;
          '-': Result := l - r;
          '*': Result := l * r;
        else
          Error ('Invalid argument in CalcFormula (' + ch + ')');
        end;
      end;
      else Error ('Invalid argument in CalcFormula (' + ch + ')')
    end;
  end;
end;

var
  Formyla: string;
  Root: PNode;

begin
  // ReadLn (Formyla);
  Formyla := '8 + 3*5*4 - 1 + 3*5'; //82
  while Formyla <> '' do begin
    Root := ReadBuf (Formyla);
    WriteLn (GetFormula (Root), ' = ', CalcFormula (Root));
    WriteLn;
    ReadLn (Formyla);
  end;
end.

[apostol584]

огромное спасибо, как добавить добавить поддержку скобок?

[Sibedir]

А я ведь предрекал вопрос

...

  TFinalFlag = (ffEndBuf, ffBracket);

...

function CharType (const ch: Char): TCharType;
begin
...
    '(', ')'         : Result := chtBracket;
...
end;

...

function ReadBuf (buf: String; var pos: Cardinal; out FinalFlag: TFinalFlag): PNode;
var
  Cur, New: PNode;
  Count: Cardinal;
  i: Integer;
  ch: Char;
  Expected {признак ожидания}, cht: TCharType;
  ff: TFinalFlag;
begin
  // подготовка
  Cur := NewNode (#0); // создаем пустой узел, делаем его текущим
  Expected := chtTerm; // ожидаем терминал

  FinalFlag := ffEndBuf;
  Count := Length (buf);
  while pos < Count do begin
    Inc (pos);
    ch := buf[pos]; // читаем очеродной символ
    cht := CharType (ch); // определяем тип символа
    case cht of
      chtTerm: begin // если текущий символ - ТЕРМИНАЛ
        if Expected <> cht then ErrorInPosition (pos); // если тип текущего символа не совпадает с ожиданием
        Cur^.Data := ch; // записываем в текущий узел терминал
        Expected := chtZnak; // ожидаем знак
      end;
      chtZnak: begin // если текущий символ - ЗНАК
        if Expected <> cht then ErrorInPosition (pos); // если тип текущего символа не совпадает с ожиданием
        while Cur^.Parent <> nil do begin // пока не достигли верха
          i := ZnakVes (ch); // определяем вес текущего знака
          if ZnakVes (Cur^.Parent^.Data) >= i then // если вес родительского узла не меньше чем вес текущего знака
            Cur := Cur^.Parent // всплываем выше
          else begin
            Break; // выходим из цикла
          end;
        end;
        New := NewNode (ch); // новый узел-знак
        if Cur^.Parent <> nil then begin // если мы не на самом верху
          // подключаемся к родителю
          New^.Parent := Cur^.Parent;
          New^.Parent^.Right := New;
        end;
        // внедряем новый узел между текущим узлом и его родителем
        Cur^.Parent := New;
        New^.Left := Cur;
        // создаем пустой узел справа от нового и делаем его текущим
        New^.Right := NewNode (#0);
        Cur := New^.Right;
        Cur^.Parent := New;

        Expected := chtTerm; // ожидаем терминал
      end;
      chtBracket: begin // если текущий символ - СКОБКА
        if ch = '(' then begin
          if Expected <> chtTerm then ErrorInPosition (pos)
          else begin
            i := pos;
            New := ReadBuf (buf, pos, ff);
            if ff = ffEndBuf then Error ('Not close bracket in ' + IntToStr(i) + ' position')
            else begin
              // создаем верхний узел-маркер
              Cur^.Data := '(';
              Cur^.Left := New;
              New^.Parent := Cur;
              Expected := chtZnak;
            end;
          end;
        end
        else begin
          if Expected <> chtZnak then
            ErrorInPosition (pos)
          else begin
            FinalFlag := ffBracket;
            Break;
          end;
        end;
      end;
      chtError, chtNil: ErrorInPosition (pos);  // если текущий символ НЕДОПУСТИМ
    end;
  end;

  // поднимаемся на самый верх
  while Cur^.Parent <> nil do Cur := Cur^.Parent;
  Result := Cur;
end;

function ReadFormula (buf: String): PNode;
var
  pos: Cardinal;
  ff: TFinalFlag;
begin
  pos := 0;
  Result := ReadBuf (buf, pos, ff);
  if ff <> ffEndBuf then Error ('Excess bracket in ' + IntToStr(pos) + ' position');
end;

function GetFormula (ANode: PNode): String;
var
  ch: Char;
  cht: TCharType;
  l, r: String;
begin
...
      chtBracket: Result := '(' + GetFormula (Left) + ')';
...
end;

function CalcFormula (ANode: PNode): Integer;
var
  ch: Char;
  cht: TCharType;
  l, r: Integer;
begin
...
      chtBracket: Result := CalcFormula (Left);
...
end;

procedure FreeTree (ARoot: PNode);
begin
  if ARoot^.Left  <> nil then FreeTree (ARoot^.Left );
  if ARoot^.Right <> nil then FreeTree (ARoot^.Right);
  Freemem (ARoot);
end;

var
  Formyla: string;
  Root: PNode;

begin
//  ReadLn (Formyla);
  Formyla := '8 + 3*5*(4 + 2*2 - (2*1 + 3)) - 1 + 3*5'; // 67
//  Formyla := '8 + 3*5*4 - 1 + 3*5'; //82
 WriteLn (Formyla);
  while Formyla <> '' do begin
    Root := ReadFormula (Formyla);
    WriteLn (GetFormula (Root), ' = ', CalcFormula (Root));
    FreeTree (Root);
    WriteLn;
    ReadLn (Formyla);
  end;
end.