Напечатать все элементы дерева Т по уровням: сначала из корня дерева, затем (слева направо) – из вершин, дочерних по отн - PascalABC.NET

Формулировка задачи:

Напечатать все элементы дерева Т по уровням: сначала из корня дерева, затем (слева направо) – из вершин, дочерних по отношению к корню и т.д. Помогите найти ошибку в коде. Влево считает все верно, а вот вправо цепляет еще и вхождения в другие ветки.

program btree;
 
var
  i, E: integer;
 
type
  ref = ^node;
  node = record   
    key, count: integer; 
    left, right: ref;  
  end;
 
procedure Include(x: integer; var p: ref);
begin
  if p = nil then   
  begin{Добавляем вершину}   
    new(p);   
    with p^ do   
    begin
      key := x;    
      count := 1;    
      left := nil;    
      right := nil;   
    end;  
  end
  else  
  begin
    if x = p^.key then  
      {Если число есть в дереве, то увеличиваем счСђтчик}   
      p^.count := p^.count + 1   else   
    if x > p^.key then  {Добавляем в правое поддерево}   
      Include(x, p^.right)      else {Добавляем в левое поддерево}   
      Include(x, p^.left);  
  end; 
end;
 
function compare(i, E: integer; var p: ref): integer;
begin
  if (p = nil) then 
  begin
    i := -1;
    writeln('Длина пути до вершины:', i);
    halt;
  end;
  if (p^.key = E) then 
  begin
    compare := 1; 
    exit;
  end;
  if (p^.key > E) then i := compare(i, E, p^.left)
  else i := compare(i, E, p^.right); //tut
  if (i = -1) then compare := -1
  else compare := i + 1;
end;
 
var
  root: ref;   
  k: integer;
 
begin
  root := nil; 
  i := 0; 
  writeln('Поиск вершины с заданным элементом:');  
  writeln('Введите числа (0 - конец ввода)');  
  read(k);
  while (k <> 0) Do 
  begin
    read(k);     
    Include(k, root);            
  end;
  writeln('Введите число:');  
  readln(E);
  i := compare(i, E, root);   
  writeln(i);
end.

Решение задачи: «Напечатать все элементы дерева Т по уровням: сначала из корня дерева, затем (слева направо) – из вершин, дочерних по отн»

Листинг программы

type
  ref = ^node;
  node = record   
    key, count: integer; 
    left, right: ref;  
  end;
 
procedure Include(x: integer; var p: ref);
begin
  if p = nil then   
    begin // Добавляем вершину
      new(p);   
      with p^ do   
        begin
          key := x;    
          count := 1;    
          left := nil;    
          right := nil;   
        end;  
    end
  else
    case Sign(x - p^.key) of
      -1 : Include(x, p^.left);  // x < key -- добавляем в левое поддерево
       0 : p^.count += 1;        // x = key -- увеличиваем счётчик
      +1 : Include(x, p^.right); // x > key -- добавляем в правое поддерево
    end;
end;
 
function compare(E: integer; p: ref; var Length : Integer) : Boolean;
begin
  if p = nil then // Нет такой вершины
    (Result, Length) := (False, -1)
  else
    begin
      Length += 1;
      case Sign(E - p^.key) of
        -1 : Result := compare(E, p^.left, Length);
         0 : Result := True;
        +1 : Result := compare(E, p^.right, Length);
      end;
    end;
end;
 
function PrintLevel(p : ref; Level : Integer) : Boolean;
begin
  if p = nil then
    begin
      Result := False;
      Exit;
    end;
  
  if Level = 0 then
    begin
      Result := True;
      Print(p^.key);
      Exit;
    end;
 
  var(L,R) := (PrintLevel(p^.left, Level-1),PrintLevel(p^.right, Level-1));
  Result := L or R;
end;
 
begin
  var root : ref := nil;
  writeln('Поиск вершины с заданным элементом:');
  writeln('Введите числа (0 - конец ввода)');
  var n : Integer;
  repeat
    n := ReadInteger;
    if n <> 0 then Include(n, root);
  until n = 0;
  
  WriteLn('Поиск заданного числа в дереве:');
  var Length := 0;
  if compare(ReadLnInteger('Введите число:'), root, Length) then
    WriteLn('Длина до вершины с таким элементом = ', Length)
  else
    WriteLn('Такого элемента нет!');
    
  WriteLn('Дерево по уровням:'); var Level := 0;
  while PrintLevel(root, Level) do
    begin
      Level += 1; WriteLn;
    end;
end.

Объяснение кода листинга программы

В данном коде используется язык программирования PascalABC.Net.

Тип данных ref представляет собой указатель на узел (вершину) двоичного дерева.
Тип данных node представляет собой запись (структуру) узла двоичного дерева.
В процедуре Include происходит добавление нового узла в дерево. Если указанный узел (вершина) еще не существует, то он создается и инициализируется. Затем происходит рекурсивный вызов процедуры для левого или правого поддерева в зависимости от значения ключа нового узла относительно ключа текущего узла.
Функция compare сравнивает элемент с ключом текущего узла и рекурсивно вызывает себя для левого или правого поддерева в зависимости от знака разности. Если элемент равен ключу текущего узла, функция возвращает значение True. Если элемент меньше ключа текущего узла, функция вызывает себя для левого поддерева и возвращает значение True только в случае, если элемент не найден в левом поддереве. Если элемент больше ключа текущего узла, функция вызывает себя для правого поддерева и возвращает значение True только в случае, если элемент не найден в правом поддереве. Если элемент не найден ни в левом, ни в правом поддереве, функция возвращает значение False.
Функция PrintLevel рекурсивно вызывает себя для левого и правого поддерева, пока не будет достигнуто условие выхода из рекурсии (уровень равен нулю). Если уровень равен нулю, функция печатает ключ текущего узла и возвращает значение True. Если ключ текущего узла равен нулю, функция возвращает значение False.
В основной части программы создается указатель на корень дерева и запрашивается ввод числа для добавления в дерево. Затем пользователю предлагается ввести число для поиска в дереве. Если число найдено в дереве, выводится длина пути от корня до найденной вершины. Если число не найдено в дереве, выводится сообщение об отсутствии такого элемента. Затем выводится дерево по уровням.