Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

A1exSun



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Код:
PROGRAM laba7;
USES CRT;
TYPE derevo=^TREE; {опис дерева}
TREE = RECORD
DATA: integer; {поле даних}
LEFT,RIGHT: derevo; {зсилки на ліву і праву гілку}
END;
mn = set of byte;
VAR ROOT: derevo; z:boolean;
M:mn;
y1,y2,y3,y4,y5,y6,y7,kol:integer; {змінні, які потрібні в програмі}
 
procedure dobavl(var a:derevo); {підпрограма додає елементи до дерева}
var kk,k:integer;
begin
write('Vvedit chislo ');
readln(k); {введення з клавіатури}
if a=nil then {перевірка на кінець дерева}
begin new(a); {відведення пам’яті для нового елементу}
a^.left:=nil; {зсилки на ліву і праву гілки спочатку = nil}
a^.right:=nil;
a^.data:=k; {присвоєння введених даних в поле елемента}
end;{Створення нового вузла }
write('e prava gilka? 1-tak 2- ni ');{буде права гілка ?}
readln(kk); {читання значення}
if kk=1 then {аналізується введене значення}
dobavl(a^.left); {функція рекурсивно викликає себе}
write('e liva gilka? 1-tak 2-ni ');{буде ліва гілка ?}
readln(kk); {читання значення}
if kk=1 then begin {аналізується введене значення}
dobavl(a^.right); {функція рекурсивно викликає сама себе}
end;
end;
 
procedure proverka(var a:derevo);
begin
if a<>nil then begin {перевірка:якщо не кінець}
if a^.data in M then z:=false
else include(m,a^.data);
proverka(a^.left); {підпрограма рекурсивно викликає сама себе}
proverka(a^.right); {підпрограма рекурсивно викликає сама себе}
end;
end;
procedure print(a:derevo;lev,pos:integer); {виведення на екран}
var m:array[1..14] of integer;
begin
m[1]:=30; m[2]:=50; m[3]:=25; m[4]:=35; m[5]:=45; m[6]:=55; m[7]:=21;
m[8]:=29; m[9]:=31; m[10]:=39; m[11]:=41; m[12]:=49; m[13]:=51; m[14]:=59;
if a<>nil then begin {якщо ще не останній елемент дерева}
if a^.left<>nil then {якщо ще не останній елемент лівої гілки дерева}
print(a^.left,lev+1,pos*2+2);
if lev=0 then
gotoxy(40,3);
if lev=1 then gotoxy(m[pos],6); {позиціонування курсору відповідно до }
if lev=2 then gotoxy(m[pos],9); { поточного рівня та елементу}
if lev=3 then gotoxy(m[pos],12);
write(a^.data);
if a^.right<>nil then {якщо ще не останній елемент правої гілки дерева}
print(a^.right,lev+1,pos*2+1);
end;
end;
 
begin
clrscr;
z:=true;
M:=[];
dobavl(ROOT); {введення дерева}
readkey;
clrscr;
write('Derevo:');
print(ROOT,0,0); {виведення введеного дерева}
proverka(root); {підрахунок кількості вузлів на введеному рівні}
gotoxy(1,20);
if z=true then
writeln('Odnakovih elementov net!') {вивести результат}
else writeln('Odnakovi elementi est');
readkey;
end.

Всего записей: 1871 | Зарегистр. 25-11-2009 | Отправлено: 21:24 19-12-2011
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru