Как Указать брата для вершины бинарного дерева

@Дмитрий19921 · Регистрация: 09.06.2011

Студворк — интернет-сервис помощи студентам

program Project2010101010101010101010;

{$APPTYPE CONSOLE}

uses
SysUtils;

type link = ^element;
element = record
data : integer;
left : link;
right : link;
end;
var
m,x, depth, minim : integer;
pn : link;

procedure add(var n : link; arg:integer);
var
ind, neo : link;
begin
new(neo);
neo^.data:=arg;
neo^.left:=nil;
neo^.right:=nil;
if n=nil then n:= neo
else begin
ind:=n;
while neo<>nil do begin
if arg<ind^.data then begin
if ind^.left=nil then begin
ind^.left:=neo;
neo:=nil
end
else ind:=ind^.left
end
else
if arg>ind^.data then begin
if ind^.right=nil then begin
ind^.right:=neo;
neo:=nil
end
else ind:=ind^.right
end
else begin
writeln('Such element is already existent');
neo:=nil;
end;
end;
end;
end; { add }
procedure restruct(var d : link);
var
ind1, ind2 : link;
begin
ind1:=d;
if ind1^.right=nil then begin
ind2:=d;
d:=ind2^.left;
dispose(ind2)
end
else
if ind1^.left=nil then begin
ind2:=d;
d:=ind2^.right;
dispose(ind2)
end
else begin
ind2:=ind1^.left;
while ind2^.right<>nil do begin
ind1:=ind2;
ind2:=ind2^.right;
end;
ind1^.right:=ind2^.left;
ind2^.left:=d^.left;
ind2^.right:=d^.right;
dispose(d);
d:=ind2;
end;
end; { restruct }

procedure delete(var n : link; arg:integer);
var
del, ind : link;
t : boolean;
begin
t:=false;
del:=n;
while (del<>nil) and (not t) do begin
if arg=del^.data then t:=true
else
if arg<del^.data then begin
ind:=del;
del:=del^.left;
end
else begin
ind:=del;
del:=del^.right;
end;
end;
if t then begin
if (del^.left=nil) and (del^.right=nil) then begin
if del=n then begin n:=nil; dispose(del) end else
if ind^.left=del then begin
ind^.left:=nil;
dispose(del)
end
else begin
ind^.right:=nil;
dispose(del)
end
end
else
if del=n then restruct(n) else
if ind^.left=del then restruct(ind^.left)
else restruct(ind^.right)
end
else writeln('Element is absent');
end; { delete }

procedure view( n : link; var d:integer);
var
i : integer;
begin
for i:=1 to d do begin
write(' ') end;
writeln(n^.data);
if (n^.left=nil) and (n^.right=nil) then d:=d-1
else begin
if n^.right<>nil then begin
d:=d+1;
view(n^.right,d);
end;
if n^.left<>nil then begin
d:=d+1;
view(n^.left, d);
end;
d:=d-1;
end;
end; { view }

procedure obhod1( n : link; var d, min:integer);
begin
if (n^.left=nil) and (n^.right=nil) then begin
if d<min then min:=d;
d:=d-1 end
else begin
if n^.right<>nil then begin
d:=d+1;
obhod1(n^.right, d, min); end;
if n^.left<>nil then begin
d:=d+1;
obhod1(n^.left, d,min) end;
d:=d-1;
end;
end; { obhod1 }

procedure obhod2( n : link; var d:integer; min:integer);
begin
if (n^.left=nil) and (n^.right=nil) then begin
if d=min then writeln(n^.data);
d:=d-1;
end
else begin
if n^.right<>nil then begin
d:=d+1;
obhod2(n^.right,d,min);
end;
if n^.left<>nil then begin
d:=d+1;
obhod2(n^.left, d,min);
end;
d:=d-1;
end;
end; { obhod2 }

begin
m:=1;
pn:=nil;
while m<>0 do begin
writeln;
writeln('- Type "1" ADD Dobavit new element');
writeln('- Type "2" DELETE element');
writeln('- Type "3" VIEW pokazat derevo');
writeln('- Type "4" FIND poisk brata dlya vershini');
writeln('- Type "0" EXIT vixod is programi');
writeln;
write('Enter : ');
readln(m);
writeln;
case m of
1 : begin
write('Enter new element : ');
readln(x);
add(pn, x);
end;
2 : begin
write('Enter element you want to delete : ');
readln(x);
delete(pn, x);
end;
3 : begin
depth:=1;
if pn=nil then writeln('The tree is empty') else begin
writeln('The tree is : ');
view(pn, depth);
end;
end;
4 : begin
depth:=1;
minim:=20;
if pn<>nil then begin
writeln('Elements with minimal depth');
obhod1(pn,depth,minim);
writeln(minim);
depth:=1;
obhod2(pn,depth,minim);
end
else writeln('The tree is empty');
end;
end; { case }
end;
end.

Новые блоги и статьи Все статьи Все блоги /
Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .
Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .	модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .

@Дмитрий19921 0 / 0 / 0 Регистрация: 09.06.2011 Сообщений: 19

	Как Указать брата для вершины бинарного дерева 09.06.2011, 19:06. Показов 533. Ответов 0 Метки нет (Все метки) program Project2010101010101010101010; {$APPTYPE CONSOLE} uses SysUtils; type link = ^element; element = record data : integer; left : link; right : link; end; var m,x, depth, minim : integer; pn : link; procedure add(var n : link; arg:integer); var ind, neo : link; begin new(neo); neo^.data:=arg; neo^.left:=nil; neo^.right:=nil; if n=nil then n:= neo else begin ind:=n; while neo<>nil do begin if arg<ind^.data then begin if ind^.left=nil then begin ind^.left:=neo; neo:=nil end else ind:=ind^.left end else if arg>ind^.data then begin if ind^.right=nil then begin ind^.right:=neo; neo:=nil end else ind:=ind^.right end else begin writeln('Such element is already existent'); neo:=nil; end; end; end; end; { add } procedure restruct(var d : link); var ind1, ind2 : link; begin ind1:=d; if ind1^.right=nil then begin ind2:=d; d:=ind2^.left; dispose(ind2) end else if ind1^.left=nil then begin ind2:=d; d:=ind2^.right; dispose(ind2) end else begin ind2:=ind1^.left; while ind2^.right<>nil do begin ind1:=ind2; ind2:=ind2^.right; end; ind1^.right:=ind2^.left; ind2^.left:=d^.left; ind2^.right:=d^.right; dispose(d); d:=ind2; end; end; { restruct } procedure delete(var n : link; arg:integer); var del, ind : link; t : boolean; begin t:=false; del:=n; while (del<>nil) and (not t) do begin if arg=del^.data then t:=true else if arg<del^.data then begin ind:=del; del:=del^.left; end else begin ind:=del; del:=del^.right; end; end; if t then begin if (del^.left=nil) and (del^.right=nil) then begin if del=n then begin n:=nil; dispose(del) end else if ind^.left=del then begin ind^.left:=nil; dispose(del) end else begin ind^.right:=nil; dispose(del) end end else if del=n then restruct(n) else if ind^.left=del then restruct(ind^.left) else restruct(ind^.right) end else writeln('Element is absent'); end; { delete } procedure view( n : link; var d:integer); var i : integer; begin for i:=1 to d do begin write(' ') end; writeln(n^.data); if (n^.left=nil) and (n^.right=nil) then d:=d-1 else begin if n^.right<>nil then begin d:=d+1; view(n^.right,d); end; if n^.left<>nil then begin d:=d+1; view(n^.left, d); end; d:=d-1; end; end; { view } procedure obhod1( n : link; var d, min:integer); begin if (n^.left=nil) and (n^.right=nil) then begin if d<min then min:=d; d:=d-1 end else begin if n^.right<>nil then begin d:=d+1; obhod1(n^.right, d, min); end; if n^.left<>nil then begin d:=d+1; obhod1(n^.left, d,min) end; d:=d-1; end; end; { obhod1 } procedure obhod2( n : link; var d:integer; min:integer); begin if (n^.left=nil) and (n^.right=nil) then begin if d=min then writeln(n^.data); d:=d-1; end else begin if n^.right<>nil then begin d:=d+1; obhod2(n^.right,d,min); end; if n^.left<>nil then begin d:=d+1; obhod2(n^.left, d,min); end; d:=d-1; end; end; { obhod2 } begin m:=1; pn:=nil; while m<>0 do begin writeln; writeln('- Type "1" ADD Dobavit new element'); writeln('- Type "2" DELETE element'); writeln('- Type "3" VIEW pokazat derevo'); writeln('- Type "4" FIND poisk brata dlya vershini'); writeln('- Type "0" EXIT vixod is programi'); writeln; write('Enter : '); readln(m); writeln; case m of 1 : begin write('Enter new element : '); readln(x); add(pn, x); end; 2 : begin write('Enter element you want to delete : '); readln(x); delete(pn, x); end; 3 : begin depth:=1; if pn=nil then writeln('The tree is empty') else begin writeln('The tree is : '); view(pn, depth); end; end; 4 : begin depth:=1; minim:=20; if pn<>nil then begin writeln('Elements with minimal depth'); obhod1(pn,depth,minim); writeln(minim); depth:=1; obhod2(pn,depth,minim); end else writeln('The tree is empty'); end; end; { case } end; end. 0