program treework; uses CRT,Graph; type PTree = ^TTree; TTree = record info:byte; left,right: PTree; end; function getint(ident:string):byte; var s:byte; begin write('Введите ',ident,' : '); readln(s); getint:=s; end; procedure addelem(var root:PTree;info:byte); var elem:PTree; begin if (root=NIL) then (* Если дерево пустое, то *) begin new(elem); (* Создать новый лист *) elem^.left:=NIL; elem^.right:=NIL; elem^.info:=info; (* Записать туда значение требуемого элемента *) root:=elem; (* Присоединить новый лист вместо пустого дерева *) end else (* Иначе *) begin if (infoNIL) then (* Если дерево не пустое *) begin printLKP(root^.left); (* Распечатать левое поддерево *) write(root^.info,' '); (* Распечатать корень дерева *) printLKP(root^.right); (* Распечать правое поддерево *) end; end; procedure printLKP_wrapper(root:PTree); begin clrscr; if (root=NIL) then (* Если дерево пустое *) writeln('Дерево пусто!') (* Сообщить об этом *) else (* Иначе *) PrintLKP(root); (* Распечатать дерево *) writeln; writeln('Нажмите любую клавишу для выхода в главное меню'); readkey; end; procedure printKLP(root:PTree); begin if (root<>NIL) then (* Если дерево не пустое *) begin write(root^.info,' '); (* Распечатать корень дерево *) printKLP(root^.left); (* Распечатать левое поддерево *) printKLP(root^.right);(* Распечатать правое поддерево *) end; end; procedure printKLP_wrapper(root:PTree); begin clrscr; if (root=NIL) then (* Если дерево пустое *) writeln('Дерево пусто!') (* Сообщить об этом *) else (* Иначе *) PrintKLP(root); (* Распечатать дерево *) writeln; writeln('Нажмите любую клавишу для выхода в главное меню'); readkey; end; procedure printLPK(root:PTree); begin if (root<>NIL) then (* Если дерево не пустое *) begin printLPK(root^.left); (* Распечатать левое поддерево *) printLPK(root^.right); (* Распечатать правое поддерево *) write(root^.info,' '); (* Распечатать корень дерева *) end; end; procedure printLPK_wrapper(root:PTree); begin clrscr; if (root=NIL) then (* Если дерево пустое *) writeln('Дерево пусто!') (* Сообщить об этом *) else (* Иначе *) PrintLPK(root); (* Распечатать дерево *) writeln; writeln('Нажмите любую клавишу для выхода в главное меню'); readkey; end; function countels(root:PTree):integer; begin if (root<>NIL) then (* Если дерево не пустое , то *) countels:=1+countels(root^.left)+countels(root^.right) (* Число его узлов - сумма числа узлов левой и правой ветвей +1 *) else (* Иначе, если дерево пустое *) countels:=0; (* Число его узлов = 0 *) end; procedure countels_wrapper(root:PTree); begin writeln('Число вершин дерева : ',countels(root)); writeln('Нажмите любую клавишу'); writeln; readkey; end; function countleafs(root:PTree):integer; begin if (root<>NIL) then (* Если дерево не пустое, то *) if (root^.left=NIL) and (root^.right<>NIL) then (* Если оно - лист,то *) countleafs:=1 (* Количество листов в нём = 1 *) else (* Иначе *) countleafs:=countleafs(root^.left)+countleafs(root^.right) (* Количество листов = сумме листов левой и правой ветвей *) else (* Иначе, если дерево пустое , *) countleafs:=0; (* Количество листов в нём = 0 *) end; procedure countleafs_wrapper(root:PTree); begin writeln('Число листов дерева : ',countels(root)); writeln; writeln('Нажмите любую клавишу'); readkey; end; function getmostright(root:PTree):byte; begin if (root^.right=NIL) then (* Если нет правого поддерева *) getmostright:=root^.info (* То этот элемент - самый правый в дереве *) else (* Иначе *) getmostright:=getmostright(root^.right); (* Самый правый элемент этого дерева - самый правый элемент его правого по ддерева *) end; procedure delelem(var root:PTree;info:byte); var temp:PTree; begin if (root<>NIL) then (* Если дерево не пустое, то *) begin if (inforoot^.info) then (* Если удаляемый элемент больше тек. узла, то *) delelem(root^.right,info) (* Удалить его из правого поддерева *) else (* Иначе тек. узел - удаляемый элемент *) begin if (root^.left=NIL) and (root^.right=NIL) then (* Если тек. узел - лист, то *) begin dispose(root); (* Удалить его *) root:=NIL; (* Поставить на его место пустое дерево *) end else if (root^.left=NIL) and (root^.right<>NIL) then (* Если у тек.узла есть только правая ветвь *) begin temp:=root; (* Присоединить её вместо тек. узла *) root:=root^.right; dispose(temp); (* Удалить тек. узел *) end else if (root^.left<>NIL) and (root^.right=NIL) then (* Если у тек.узла есть только левая ветвь *) begin temp:=root; (* Присоединить её вместо тек. узла *) root:=root^.left; dispose(temp); (* Удалить тек. узел *) end else (* Иначе у узла есть обе ветви *) begin root^.info:=getmostright(root^.left); (* Вставить на место узла самый правый эл-т левого поддерева *) delelem(root^.left,root^.info); (* Удалить самый правый эл-т из левого поддерева *) end; end; end; end; procedure printlevel(root:Ptree;level,curlevel:integer); begin if (root<>NIL) then (* Если дерево не пустое, то *) begin if (curlevel=level) then (* Если тек.вершина на нужном уровне, то *) write(root^.info,' ') (* Распечатать её *) else (* Иначе *) begin printlevel(root^.left,level,curlevel+1); (* Распечатать все вершины треб. уровня в левом по ддереве *) printlevel(root^.right,level,curlevel+1); (* Распечатать все вершины треб. уровня в правом по ддереве *) end; end; end; procedure printlevel_wrapper(root:PTree;level:integer); begin clrscr; writeln('Все вершины на уровне ',level,' : '); printlevel(root,level,0); writeln; writeln('Нажмите любую клавишу для выхода в главное меню'); readkey; end; function countdepth(root:PTree;level:integer):integer; var dr,dl:integer; begin if (root=NIL) then (* Если дерево пустое, то *) countdepth:=level-1 (* Глубина текущей ветви = текущему уровню - 1*) else (* Иначе *) begin dr:=countdepth(root^.left,level+1); dl:=countdepth(root^.right,level+1); if (dr>dl) then (* Глубина текущей ветви равна максимальной из глубин её поддеревьев *) countdepth:=dr else countdepth:=dl; end; end; procedure countdepth_wrapper(root:PTree); begin if (root<>NIL) then begin writeln('Глубина дерева : ',countdepth(root,0)); writeln; writeln('Нажмите любую клавишу'); end else writeln('Дерево пусто!'); readln; end; procedure drawtree(root:PTree); var Width,Height:integer; CurVPort:ViewPortType; s:string; begin if (root<>NIL) then (* Если дерево не пустое, то *) begin GetViewSettings(CurVPort); width:=CurVPort.x2-CurVPort.x1; height:=CurVPort.y2-CurVPort.y1; str(root^.info,s); OutTextXY(width div 2,0,s); (* Вывести значение вершины в верх-центр тек. окна *) if (root^.left<>NIL) then (* Если у вершины есть левая ветвь *) line(width div 2,8,width div 4,height-3); (* Нарисовать отрезок прямой к левой ветви *) if (root^.right<>NIL) then (* Если у вершины есть правая ветвь *) line(width div 2,8,3*width div 4,height-3); (* Нарисовать отрезок прямой к правой ветви *) with CurVPort do (* Разбить тек. окно по горизонтали пополам, выбрать левую часть, перейти к след. уровню *) setviewport(x1,y2,x1+(width div 2),y2+height,ClipOff); drawtree(root^.left); (* Вывести левое поддерево *) with CurVPort do (* Разбить тек. окно по горизонтали пополам, выбрать правую часть, перейти к след. уровню *) setviewport(x1+(width div 2),y2,x2,y2+height,ClipOff); drawtree(root^.right); (* Вывести правое поддерево *) end; end; procedure drawtree_wrapper(root:PTree); Var GraphDevice,GraphMode:integer; PathToDriver:string; begin if (root<>NIL) then (* Если дерево не пустое *) begin GraphDevice:=Detect; PathToDriver:=''; InitGraph(GraphDevice,GraphMode,PathToDriver); (* Инициализировать графику *) if (GraphResult<>grOK) then (* Если инициализация не удалась, то *) begin Writeln('Error initializing graphics!'); (* Сообщить об этом *) readkey; end else (* Иначе *) begin SetViewPort(0,0,GetMaxX,(GetMaxY div (countdepth(root,0)+1)),ClipOff); (*Установить окно на всю ширину экрана и 0й уровень дерева *) SetTextJustify(CenterText,TopText); drawtree(root); (* Нарисовать дерево *) readkey; closegraph; end end else (* Иначе *) begin writeln('Дерево пусто!'); (* Сообщить об этом *) readkey; end; end; procedure showmenu; begin clrscr; writeln(' Бинарное дерево'); writeln; writeln(' 1) Добавить элемент в дерево'); writeln(' 2) Распечатать дерево в виде левая ветвь - корень - правая ветвь (ЛКП)'); writeln(' 3) Распечатать дерево в виде корень - левая ветвь - правая ветвь (КЛП)'); writeln(' 4) Распечатать дерево в виде левая ветвь - правая ветвь - корень (ЛПК)'); writeln(' 5) Вывести число вершин дерева'); writeln(' 6) Вывести число листов дерева'); writeln(' 7) Удалить элемент из дерева'); writeln(' 8) Распечатать все вершины на заданном уровне'); writeln(' 9) Вывести глубину дерева'); writeln(' 10) Нарисовать дерево'); writeln(' 11) Выход'); writeln; write('Ваш выбор : '); end; Var Tree:PTree; selection:integer; begin Tree:=NIL; (* Создать пустое дерево *) repeat showmenu; (* Вывести на экран меню *) readln(selection); (* Считать с клавиатуры выбор пользователя *) writeln; case selection of (* Выполнить действия в соответствии с этим выбором *) 1: addelem(Tree,getint('элемент для добавления')); 2: printLKP_wrapper(Tree); 3: printKLP_wrapper(Tree); 4: printLPK_wrapper(Tree); 5: countels_wrapper(Tree); 6: countleafs_wrapper(Tree); 7: delelem(Tree,getint('элемент для удаления')); 8: printlevel_wrapper(Tree,getint('уровень, который нужно распечатать')); 9: countdepth_wrapper(Tree); 10: drawtree_wrapper(Tree); 11:clrscr; end; until selection=11; end.