Контрольная работа - №4 (Программирование)
.docУчреждение образования Белорусский Государственный Университет Информатики и Радиоэлектроники
Факультет заочного и дистанционного обучения
Специальность: Информатика
Контрольная работа по предмету
Программирования №4
Задание:
Написать программу (Unit1), иллюстрирующую методы работы с деревом поиска. Результат формирования и преобразования дерева показывать в компоненте TTreeView. Написать обработчик события, реализующий работу с методом решения своего варианта.
Индивидуальный вариант №8 (Номер зачётной книжки 7 +1):
Найти в дереве длину (число ветвей) пути от корня до ближайшей вершины.
Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Buttons;
type
TInfo = Integer;
PItem = ^Item;
Item = Record
Key: TInfo;
Left, Right: PItem;
end;
TForm1 = class(TForm)
TreeView: TTreeView;
ButtonOfAdd: TButton;
ComboBoxOfAdd: TComboBox;
ButtonOfDel: TButton;
EditOfDel: TEdit;
ButtonOfCheck: TButton;
EditOfCheck: TEdit;
ButtonOfExit: TBitBtn;
ButtonOfFind: TButton;
EditOfFind: TEdit;
procedure ButtonOfAddClick(Sender: TObject);
procedure Prosmotr(P:PItem;Item:TTreeNode);
procedure ButtonOfDelClick(Sender: TObject);
procedure ButtonOfCheckClick(Sender: TObject);
procedure ButtonOfExitClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ButtonOfFindClick(Sender: TObject);
procedure EditOfFindClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TTree = class
private
Root:PItem;
public
constructor Create;
procedure Add (var p:PItem; Key:TInfo);
procedure Del (var P:PItem; Key:TInfo);
function Check (var P:PItem):String;
function Find (key:Tinfo):ShortInt;
destructor Destroy (P: PItem);
end;
var
Form1: TForm1;
Tree: TTree;
Key: TInfo;
implementation
constructor TTree.Create;
begin
Root := nil;
end;
procedure TTree.Add(var p:PItem;Key: TInfo); // Процедура добавляет элемент
// в дерево
begin
if p=Nil then // Если узел пуст
begin
New(p); // создаем новый узел
p^.Left:=nil; // Левый указатель на Nil
p^.Right:=nil; // Правый указателт на Nil
p^.key:=key;
end
else // Если узал не пуст, то
if key<p^.key then // Если доб. элемент меньше
Add(p^.Left,key) // Добавляем его слева
еlse // Если больше
Add(p^.Right,key); // Добавляем справа
end;
procedure TTree.Del(var P:PItem; Key: TInfo); // Удаление узла
var Q: PItem;
procedure Delete(var R: PItem);
// процедура удаляет узел имеющий двух потомков, заменяя его на самый правый
// узел левого поддерева
begin
if R^.Right <> nil then // обойти дерево справа
Delete(R^.Right)
else begin
// дошли до самого правого узла
// заменить этим узлом удаляемый
Q^.Key := R^.Key;
Q := R;
R := R^.Left;
end;
end; // Delete
begin // Del
if P <> nil then // искать удаляемый узел
if Key < P^.Key then // Если Уд.Элемент меньше
Del(P^.Left, Key) // Искать в левом поддереве
else // Если больше
if Key > P^.Key then
Del(P^.Right, Key) // искать в правом поддереве
else begin
// узел найден, надо его удалить
// сохранить ссылку на удаленный узел
Q := P;
if Q^.Right = nil then
// справа nil
// и ссылку на узел надо заменить ссылкой на этого потомка
P := Q^.Left
else
if Q^.Left = nil then
// слева nil
// и ссылку на узел надо заменить ссылкой на этого потомка
P := P^.Right
else // узел имеет двух потомков
Delete(Q^.Left);
Dispose(Q);
end;
end;
procedure TForm1.Prosmotr(P:PItem;Item:TTreeNode); // Просмотр дерева
var
TmpItem:TTreeNode;
begin
if P <> nil then
begin
TmpItem:=TreeView.Items.AddChild(Item,IntToStr(P^.Key));
Prosmotr(P^.Left,TmpItem);
Prosmotr(P^.Right,TmpItem);
TreeView.FullExpand;
end;
end;
function TTree.Check(var P:PItem):String; // Проверяет, есть ли в дереве
var //одинаковые элементы
i,n:byte; Elem,Str:String;
function Recording(P:PItem):String; // Записивает все элементы дерева в строку
begin
if P<>nil then
Recording:=Recording(p^.Left)+IntToStr(p^.key)+' '+Recording(p^.Right)
end;
begin // Check
n:=0;
Str:=Recording(Root);
i:=Pos(' ',Str);
while i<>0 do
begin
Elem:=Copy(Str,1,i);
n:=n+Pos((' '+Elem),Str);
Delete(Str,1,i);
i:=Pos(' ',Str);
end;
if n<>0 then
Check:='В дереве есть одинаковые элементы'
else
Check:='В дереве нет одинаковых элементов';
end;
// Функция ноходит в дереве длину пути от корня до ближайшей вершины с заданным значением.
function TTree.Find(key:Tinfo):ShortInt;
var
n:shortint;
procedure Search(var p:PItem;x:Tinfo);
begin
if p=nil then n:=-1
else
if x=p^.Key then n:=n+1
else
if x>p^.Key then
begin
n:=n+1;
Search(p^.right,x);
end
else
begin
n:=n+1;
Search(p^.Left,x);
end;
end; //Search
begin //Find
n:=-1;
Search(Root,key);
Find:=n;
end;
destructor TTree.Destroy(P: PItem); // Удаляет узел и всех его потомков в дереве
begin
if P <> nil then begin
if P^.Left <> nil then
Destroy(P^.Left);
if P^.Right <> nil then
Destroy(P^.Right);
Dispose(P);
end;
end;
{$R *.dfm}
procedure TForm1.ButtonOfAddClick(Sender: TObject); // Добавить элемент
var
Item:TTreeNode;
begin
Item:=nil;
Key:=StrToInt(ComboBoxOfAdd.Text);
Tree.Add(Tree.Root,Key);
TreeView.Items.Clear;
Prosmotr(Tree.Root,Item);
end;
procedure TForm1.ButtonOfDelClick(Sender: TObject); // Удалить элемент
var
Item:TTreeNode;
begin
Item:=nil;
Key:=StrToInt(EditOfDel.Text);
Tree.Del(Tree.Root,Key);
EditOfDel.Clear;
TreeView.Items.Clear;
Prosmotr(Tree.Root,Item);
end;
procedure TForm1.ButtonOfCheckClick(Sender: TObject); // Проверка
begin
EditOfCheck.Text:=Tree.Check(Tree.Root)
end;
procedure TForm1.ButtonOfExitClick(Sender: TObject); // Выход
begin
Close;
Tree.Destroy(Tree.Root);
end;
procedure TForm1.FormActivate(Sender: TObject); // Инициализация дерева
begin
Tree:= TTree.Create;
end;
procedure TForm1.ButtonOfFindClick(Sender: TObject); // Поиск
begin
key:=StrToInt(EditOfFind.Text);
EditOfFind.Text:=FloatToStr(Tree.Find(key));
end;
procedure TForm1.EditOfFindClick(Sender: TObject);
begin
EditOfFind.Clear;
end;
end.