Студопедия — Программа №4
Студопедия Главная Случайная страница Обратная связь

Разделы: Автомобили Астрономия Биология География Дом и сад Другие языки Другое Информатика История Культура Литература Логика Математика Медицина Металлургия Механика Образование Охрана труда Педагогика Политика Право Психология Религия Риторика Социология Спорт Строительство Технология Туризм Физика Философия Финансы Химия Черчение Экология Экономика Электроника

Программа №4






 

program bin_tree;

const n = 8;

type pnode = ^node;

node = record

v: integer;

right, left: pnode;

lf, rf: boolean;

end;

var root: pnode;

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

v: integer;

right, left: pnode;

j, h, i, answ, answ2: integer;

const m: array[1..n] of integer = (5,4,8,6,1,7,3,9);

 

{------------ create of tree -------------}

 

procedure 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;

begin

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; end;

 

{--------- View of tree --------------------}

procedure ViewTree(root: pnode);

var 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;

begin

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;

end;

{------------- Прямой порядок прохождения -------------}

procedure PrintDown(level: integer; root: pnode);

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

begin 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; end;

{--------------- Симметричный порядок прохождения -------}

procedure PrintLex(level: integer; root: pnode);

begin

if root = nil then exit; with root^ do begin PrintLex(level+1, left); writeln('':2*level, v);

PrintLex(level+1, right); end end;

 

{----------- Концевой порядок прохождения ----------}

 

procedure PrintUp(level: integer; root: pnode);

begin

if root = nil then exit; with root^ do begin PrintUp(level+1, left); PrintUp(level+1, right);

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

 

{------------ прошивка ------------------------------}

procedure Threading(x: pnode);

var 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;

begin

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

{прошиваем лист}

begin stop:= false; rightPointer(root, i); end; writeln(' ',v);

if lf = true then {если узел или лист прошит} exit; {выходим}Threading(right);

end; end;

{------------- формирование дерева ---------------}

procedure Cycle;

begin

for i:= 1 to n do Insert(root, m[i]); end;

 

{----------------------------------------------------}

 

begin

Cycle;

{определим высоту дерева обходом сверху-вниз}

PrintDown(1, root); writeln('Выберите действие');

while true do begin writeln('1 - провести обход, 2 - отобразить дерево, 3 - выполнить прошивку, 4 - выход');

readln(answ);

case answ of

1: begin if st = true then writeln('Обход невозможен - дерево прошито')

else begin writeln('Выберите обход: 1 - сверху-вниз, 2 - слева-направо, 3 - снизу-вверх');

readln(answ2); case answ2 of

1:begin writeln('Обход сверху-вниз:'); PrintDown(1, root); end;

2:begin writeln('Обход слева-направо:'); PrintLex(1, root); end;

3:begin writeln('Обход снизу-вверх:'); PrintUp(1, root); end; end; end; end;

2: if st = true then writeln('Дерево прошито - его представление невозможно')

else

begin writeln('Представление дерева:'); {вызоваем процедуру представления дерева}

ViewTree(root); end;

3: begin if st = true then writeln('Дерево уже прошито')

else begin writeln('Прошивка:'); i:= 0; j:= 0; Threading(root); st:= true; end; end;

4: exit; end; writeln; end; end.

 

 







Дата добавления: 2015-08-12; просмотров: 321. Нарушение авторских прав; Мы поможем в написании вашей работы!



Вычисление основной дактилоскопической формулы Вычислением основной дактоформулы обычно занимается следователь. Для этого все десять пальцев разбиваются на пять пар...

Расчетные и графические задания Равновесный объем - это объем, определяемый равенством спроса и предложения...

Кардиналистский и ординалистский подходы Кардиналистский (количественный подход) к анализу полезности основан на представлении о возможности измерения различных благ в условных единицах полезности...

Обзор компонентов Multisim Компоненты – это основа любой схемы, это все элементы, из которых она состоит. Multisim оперирует с двумя категориями...

Краткая психологическая характеристика возрастных периодов.Первый критический период развития ребенка — период новорожденности Психоаналитики говорят, что это первая травма, которую переживает ребенок, и она настолько сильна, что вся последую­щая жизнь проходит под знаком этой травмы...

РЕВМАТИЧЕСКИЕ БОЛЕЗНИ Ревматические болезни(или диффузные болезни соединительно ткани(ДБСТ))— это группа заболеваний, характеризующихся первичным системным поражением соединительной ткани в связи с нарушением иммунного гомеостаза...

Решение Постоянные издержки (FC) не зависят от изменения объёма производства, существуют постоянно...

Сущность, виды и функции маркетинга персонала Перснал-маркетинг является новым понятием. В мировой практике маркетинга и управления персоналом он выделился в отдельное направление лишь в начале 90-х гг.XX века...

Разработка товарной и ценовой стратегии фирмы на российском рынке хлебопродуктов В начале 1994 г. английская фирма МОНО совместно с бельгийской ПЮРАТОС приняла решение о начале совместного проекта на российском рынке. Эти фирмы ведут деятельность в сопредельных сферах производства хлебопродуктов. МОНО – крупнейший в Великобритании...

ОПРЕДЕЛЕНИЕ ЦЕНТРА ТЯЖЕСТИ ПЛОСКОЙ ФИГУРЫ Сила, с которой тело притягивается к Земле, называется силой тяжести...

Studopedia.info - Студопедия - 2014-2024 год . (0.013 сек.) русская версия | украинская версия