freepascal.ru

пытаюсь построить бинарное дерево по принципу направо больший налево меньший, и отсортировать по нему массив, но вот гдето закрались баги. подскажите плиз где накосячил. вот код:

Код: Выделить всё

program treemake;
uses crt;
const
     n = 10;
type
    ptr = ^tr;
    tr = record
          data : integer;
          left : ptr;
          right : ptr;
         end;
var
   tree : ptr;
   mas : array[1..n] of integer;
   j,k : integer;

procedure addleaf(var a : ptr; b : integer); {добавление эл-та}
var
   x,y : ptr;
begin
new(x);
x^.data := b;  x^.left := nil;  x^.right := nil;
if a = nil then a := x
  else
  begin
   y := a;
   while y <> nil do
   begin
    if x^.data < y^.data then y := y^.left
     else y := y^.right;
   end;
   x := y;
  end;
end;

procedure MakeTree(var a : ptr; b : array of integer);
var
   i : integer;
begin
for i := 1 to n do AddLeaf(a,b[i]);
end;

procedure PrintTree(a : ptr); {обход дерева в обратном порядке}
begin
if a^.left <> nil then PrintTree(a^.left);
write(a^.data,' ');
if a^.right <> nil then PrintTree(a^.right);
end;

begin
clrscr;
randomize;
for j := 1 to n do
begin
  mas[j] := random(n);
  write(mas[j],' ');
end;
new(tree);
writeln;
MakeTree(tree,mas);
PrintTree(tree);
readkey;
end.


Уважаемый glupo.
Давайте попробуем разобраться:
Итак, в начальный момент времени Вы создаёте переменную Tree, поэтому при первом вызове процедуры AddLeaf переменная a заведомо не равна Nil, но при этом значение её полей не определено (вернее, зависит от компилятора: может быть "куча мусора" или все нули). Что уже приводит к нежелательным последствиям: как минимум, у Вас в выходном массиве будет на 1 элемент больше, если же компилятор не обнуляет вновь созданную переменную, то возможны как ошибки доступа, так и "вечные" циклы (одна случайная непустая область памяти даст ссылку на другую, которая ...).
Далее,

Код: Выделить всё

while y <> nil do begin
  if x^.data < y^.data then y := y^.left else y := y^.right;
end;

в общем случае не работает.
Представьте, что у Вас в некий момент времени в дереве хранятся 4 числа: 1, 2, 4, 5. Корень дерева — 2. А Вам нужно в дерево вставить число 3.
Тогда: 3>2 => y=4, цикл не завершен, на следующем шаге 3<4 => y=2, цикл не завершен, повторять пока не надоест...
Но, даже если Вам повезло, и число нужно вставить в начало или конец дерева, Вы строкой

Код: Выделить всё

x := y;

приравниваете x Nil, ведь, по условию, цикл завершается только при y=Nil.
Я тут вчерне набросал вариант решения:

Код: Выделить всё

procedure AddLeaf(var a : ptr; b : integer); {добавление эл-та}
var
  p, x:Ptr;
  StepRight:Boolean;
begin
  if a=nil then begin
//    Writeln('First =', b);
    New(a);
    a^.Data:=b;
    a^.Left:=nil;
    a^.Right:=nil
  end else begin
    if a^.Data<b then StepRight:=True else StepRight:=False;
    p:=a;
    if StepRight then begin
      While p^.Data<b do begin
//        writeln(p^.Data,' < ',b);
        if p^.Right=nil then begin
          StepRight:=not(StepRight);
          Break
        end else p:=p^.Right;
        end;
    end else begin
      While p^.Data>=b do begin
//        writeln(p^.Data,' >= ',b);
        if p^.Left=nil then begin
          StepRight:=not(StepRight);
          Break
        end else p:=p^.Left;
        end;
    end;
    New(x);
    x^.Data:=b;
    if StepRight then begin
      x^.Left:=p^.Left;
      if p^.Left<>nil then p^.Left^.Right:=x;
      x^.Right:=p;
      p^.Left:=x
    end else begin
      x^.Right:=p^.Right;
      if p^.Right<>nil then p^.Right^.Left:=x;
      x^.Left:=p;
      p^.Right:=x
    end;
{      Write('Вставим ', x^.Data, ' между ');
      if x^.Left=nil then Write ('Nil и ') else Write (x^.Left^.Data,' и ');
      if x^.Right=nil then WriteLn ('Nil') else WriteLn (x^.Right^.Data);}
  end;
//  PrintTree(a)
end;

.
Теперь о выводе дерева на экран: задумка несомненно красивая, однако, в том виде, который Вы предложили — гарантированно не работоспособная (дерево уже из 2 элементов будет распечатываться вечность, поскольку из процедуры печати первого будет вызвана процедура печати второго, из которой будут вызвана процедура печати первого, из которой...).
Рискну предложить такой вариант

Код: Выделить всё

procedure PrintTree(a : ptr); {обход дерева в обратном порядке}
var
  x:ptr;
begin
  x:=a;
  While x^.Left<>Nil do x:=x^.Left;
  while x<>Nil do begin
    if x=a then Write('[',x^.Data,'] ') else Write(x^.Data,' ');
    x:=x^.Right
  end;
  WriteLn
end;

.
Надеюсь, что смог помочь.

С уважением, Алексей.

Glupo, простите, пожалуйста.
Я, в силу Нового года и общего раздолбайства, насоветовал Вам всякой ерунды, имеющей слабое отношение к поставленной задаче. Причём "убедительно и аргументированно" забраковал вполне работающий алгоритм вывода дерева . А потом, "с барского плеча" предложил свой способ вывода, который как раз на древовидной структуре работать и не будет .
Впрочем, пару наиболее серьёзных проколов в Вашем коде я всё-таки, кажется, нашёл и показал. Так что, вероятно, сейчас вы уже сами решили поставленную задачу. Однако, на всякий случай, высылаю переработанный вариант:

Код: Выделить всё

program p1;
const
  Num=10;
type
  PNode=^TNode;
  TNode=record
    Data:integer;
    Left, Right:PNode
  end;
var
  Mas:array [1..Num] of Integer;
  i:integer;
  Root:PNode;
procedure AddLeaf(var Node:PNode;Data:Integer);
var
  x:PNode;
begin
  if Node=nil then begin
    New(Node);
    Node^.Data:=Data;
    Node^.Left:=Nil;
    Node^.Right:=Nil;
    Exit
  end;
  if Node^.Data<Data then begin
    if Node^.Right=nil then begin
      New(x);
      x^.Data:=Data;
      x^.Left:=Nil;
      x^.Right:=Nil;
      Node^.Right:=x
    end else AddLeaf(Node^.Right, Data)
  end else begin
    if Node^.Left=nil then begin
      New(x);
      x^.Data:=Data;
      x^.Left:=Nil;
      x^.Right:=Nil;
      Node^.Left:=x
    end else AddLeaf(Node^.Left, Data)
  end
end;
procedure ShowLeafs(Node:PNode);
begin
  if Node=nil then exit; // Всё-таки, я думаю, нужно проверять, не пустой ли начальный элемент
  ShowLeafs(Node^.Left);
  Write(Node^.Data,' ');
  ShowLeafs(Node^.Right);
end;
begin
  Randomize;
  for i:=1 to Num do
    Mas[i]:=Random(10);
  for i:=1 to Num do
    Write(Mas[i],' ');
  WriteLn;
  for i:=1 to Num do
    AddLeaf(Root, Mas[i]);
  ShowLeafs(Root);
  WriteLn
end.

.
Ещё раз прошу прощения.

С уважением, Алексей.