Бинарное дерево

Контрольная работа - Компьютеры, программирование

Другие контрольные работы по предмету Компьютеры, программирование

end;root : pnode;

st : boolean; {флажок для определения прошито ли дерево}

v : integer;

right, left : pnode;

j, h, i, answ, answ2 : integer;m : array[1..n] of integer = (5,4,8,6,1,7,3,9);

 

{------------ create of tree -------------}Insert(var root: pnode; X: integer);

{Дополнительная процедура, создающая и инициирующая новый узел}

procedure CreateNode(var p : pnode; n : integer);

begin

new(p);

p^.v := n;

p^.left := nil;

p^.right := nil;

end;

if root = nil then

CreateNode(root, X) {создаем новый узел дерева}

else

with root^ do

begin

if v < X then

Insert(right, X)

else

if v > X then

Insert(left, X)

else

{Действия, производимые в случае повторного внесения

элементов в дерево}

begin

writeln('Такой элемент уже есть');

exit;

end;

end;

;

{--------- View of tree --------------------}ViewTree(root : pnode);mas1, mas2 : array[1..8] of integer;

q, m1, m2 : integer;

Sch, Chl, Chr : pnode;

{функция для определения количества отступов}

function sc(s : integer) : integer;

var c, c1, w : integer;

begin

c := 0;

sc := 0;

s := s-1;

if s = 0 then

exit;

for w := 1 to s do

begin

c1 := 1+2*c;

c := c1;

end;

sc := c1;

end;

{поиск узла или листа дерева по значению v}

procedure Search(root : pnode; s : integer);

begin

if root^.v = s then

begin

Sch := root;

exit;

end;

if root = nil then

exit

else

begin

Search(root^.right, s);

Search(root^.left, s);

end;

end;

{занесение потомков узлов дерева одного уровня во 2-ой массив}

procedure ToMas2;

begin

if Sch^.left <> nil then

begin

Chl := Sch^.left;

m2 := m2+1;

mas2[m2] := Chl^.v;

end

else

begin

m2 := m2+1;

mas2[m2] := 0;

end;

if Sch^.right <> nil then

begin

Chr := Sch^.right;

m2 := m2+1;

mas2[m2] := Chr^.v;

end

else

begin

m2 := m2+1;

mas2[m2] := 0;

end;

end;

{занесение потомков узлов дерева следующего уровня в первый массив}

procedure ToMas1;

begin

if Sch^.left <> nil then

begin

Chl := Sch^.left;

m1 := m1+1;

mas1[m1] := Chl^.v;

end

else

begin

m1 := m1+1;

mas1[m1] := 0;

end;

if Sch^.right <> nil then

begin

Chr := Sch^.right;

m1 := m1+1;

mas1[m1] := Chr^.v;

end

else

begin

m1 := m1+1;

mas1[m1] := 0;

end;

end;

{если уровень дерева не является последним - заносим 2 нуля в первый массив}

procedure NilToMas1;

begin

if i > 1 then

begin

m1 := m1+1;

mas1[m1] := 0; {первый ноль}

m1 := m1+1;

mas1[m1] := 0; {второй ноль}

end;

end;

{если уровень не последний - заносим нули во второй массив}

procedure NilToMas2;

begin

if i > 1 then

begin

m2 := m2+1;

mas2[m2] := 0;

m2 := m2+1;

mas2[m2] := 0;

end;

end;

mas1[1] := root^.v;

m1 := 1;

m2 := 0;

for i := h downto 1 do

begin

writeln;

{отображаем первый элемент уровня}

if mas1[1] = 0 then

begin

NilToMas2;

write('':(sc(i)+1));

end

else

begin

write('':sc(i), mas1[1]);

Search(root, mas1[1]);

ToMas2;

end;

{отображаем остальные элементы, если уровень дерева не содержит корень}

if m1 > 1 then

begin

for q := 2 to m1 do

if mas1[q] = 0 then

begin

NilToMas2;

write('':(sc(i+1)+1));

end

else

begin

write('':sc(i+1), mas1[q]);

Search(root, mas1[q]);

ToMas2;

end;

end;

m1 := 0;

{на следующий уровень}

if i = 1 then

break

else

i := i-1;

writeln;

if mas2[1] = 0 then

begin

NilToMas1;

write('':(sc(i)+1));

end

else

begin

write('':sc(i), mas2[1]);

Search(root, mas2[1]);

ToMas1;

end;

for q := 2 to m2 do

begin

if mas2[q] = 0 then

begin

NilToMas1;

write('':(sc(i+1)+1));

end

else

begin

write('':sc(i+1), mas2[q]);

Search(root, mas2[q]);

ToMas1;

end;

end;

m2 := 0;

{на следующий уровень}

end;;

{------------- Прямой порядок прохождения -------------}PrintDown(level : integer; root : pnode);

{в этом обходе заодно рассчитаем высоту дерева h для его представления}

if root = nil then

exit;

with root^ do

begin

{для прошивки дерева устанавливаем флажки}

if right = nil then

rf := false;

lf := false;

{определяем высоту дерева}

if (left = nil) and (right = nil) then

begin

j := j+1;

if h < j then

{высотой дерева является его максимальный путь прохождения}

h := j;

j := 0;

end;

writeln('':2*level, v);

j := j+1;

PrintDown(level+1, left);

PrintDown(level+1, right)

end;;

{--------------- Симметричный порядок прохождения -------}PrintLex(level : integer; root : pnode);

if root = nil then

exit;

with root^ do

begin

PrintLex(level+1, left);

writeln('':2*level, v);

PrintLex(level+1, right);

end;

{----------- Концевой порядок прохождения ----------}PrintUp(level : integer; root : pnode);

if root = nil then

exit;

with root^ do

begin

PrintUp(level+1, left);

PrintUp(level+1, right);

writeln('':2*level, v);

end;

{------------ прошивка ------------------------------}Threading(x : pnode);p : pnode;

stop : boolean;

{устанавливаем указатель}

procedure rightPointer(y : pnode; i : integer);

begin

if stop = true then

exit;

j := j+1; {подсчитываем число рекурсий}

if y = nil then

exit;

with y^ do

begin

rightPointer(left, i);

if (j > i) and (rf = true) then

begin

j := 0;

writeln('Прошиваем ', x^.v, ' элемент с ', v);

x^.right := y;

{сворачиваем рекурсию}

stop := true;

{помечаем, что узел или лист прошит}

x^.lf := true;

exit;

end;

if lf = true then

exit;

rightPointer(right, i);

end

end;

 

i := i+1; {подсчитываем число рекурсий}

if x = nil then

exit;

with x^ do

begin

rf := true; {помечаем, что узел или лист посещался}

Threading(left);

if (rf = true) and (right = nil) then

{если узел не прошит}

begin

stop := false;

{прошиваем его}

rightPointer(root, i);

end;

if (left = nil) and (right = nil) then