Реализация древовидной структуры

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

Type Uk=^Tree;

Tree=record

Inf:integer;

Left, right:Uk;

End;

Для работы с деревом, расположенным в динамической области, необходим по крайней мере один указатель – указатель на корень дерева (Root).

2. Процедуры обработки деревьев:

· Поиск элемента в дереве;

· Добавление элемента в дерево;

· Удаление элемента из дерева;

· Обход дерева.

Рассмотрим основные процедуры обработки дерева. В начале программы следует сделать инициализацию дерева:

procedure Init(var root:Uk);

begin

root:=nil;

end;

Добавление элемента в деревосостоит из трех шагов:

· создание вершины (выделение области памяти, заполнение информационных и адресных полей),

· поиск вершины, к которой можно присоединить новую вершину, не нарушая правила построения дерева,

· присоединение вершины, т.е. организация связи между родительской вершиной и вставляемой вершиной.

Основное назначение двоичного дерева поиска поиск данных.

Function Poisk (var root:Uk; a:integer):Uk;

{а- искомое значение}

Begin

p:=root;

while (p<>nil) and (p^.inf<>a) do

if a<p^.inf then p:=p^.left

else p:=p^.right;

Poisk:=p;

End;

Данная функция поиска возвращает адрес найденного элемента или нулевой адрес, если искомого элемента в дереве нет.

2.3 Удаление вершины

Непосредственное удаление вершины реализуется в зависимости от того, какая вершина удаляется:

§ Удаляемая вершина не содержит поддеревьев (лист). При этом удаляется ссылка на удаляемую вершину из родительской вершины.

§ Удаляемая вершина содержит одну ветвь. Для удаления необходимо скорректировать соответствующую ссылку в родительской вершине, заменив адрес удаляемой вершины адресом вершины, из нее исходящей.

§ Удаляемая вершина содержит две ветви. В этом случае нужно найти подходящую вершину, которую можно вставить на место удаляемой, причем эта вершина должна легко перемещаться. Такая вершина всегда существует: либо это самый правый элемент левого поддерева, либо – самый левый элемент правого поддерева.

Procedure Delete(var r:Uk; a:integer);

{r-указатель на корень, а - искомое значение }

{внутренняя процедура поиска заменяющей вершины в левом поддереве}

Procedure DEL(var r:Uk; q:Uk);

{r- адрес корня левого поддерева, q- адрес заменяемой вершины }

Var q1:Uk;

Begin

if r^.right=nil then {заменяющая вершина найдена}

begin

q^.inf:=r^.inf; {копируем значение}

q1:=r;

r:=r^.left; {запоминаем адрес левого поддерева}

dispose(q1); {удаляем заменяющую вершину}

end

else DEL(r^.right,q); {идем на правое поддерево}

End;

Var q:Uk;

Begin

if r=nil then writeln('элемент не найден')

else {поиск элемента с заданным ключом}

if a<r^.inf then {если меньше, то налево}

DELETE(r^.left,a)

else

if a>r^.inf then {если больше, то направо}

DELETE (r^.right,a)

else

begin

{удаление листа или корня с одним поддеревом}

if r^.right=nil then

{нет правого поддерева}

begin

q:=r;

r:=r^.left;

dispose(q);

end

else

if r^.left=nil then {нет левого поддерева}

begin

q:=r;

r:=r^.right;

dispose(q);

end

else

{удаление корня с двумя поддеревьями}

DEL(r^.left,r);

end;

end;

2.4 Удаление всего дерева. Для высвобождения памяти дерево удаляется целиком. Для этого используется обход дерева снизу вверх Postorder.

Procedure Del_tree (var beg:Uk);

Begin

If beg<>nil then begin

Del_tree(beg^.left)

Del_tree(beg^.right);

Dispose(beg);

Beg:=nil;

End;

End;

Устройство программы

Итак, наша программа начинается с названия – Цветочный магазин. Я не стал ее называть по-другому, так как название программы должно отображать задание. После названия обязательно нужно объявить тип запись, так как элемент дерева, как и элемент списка, представляет собой запись, содержащую информационные поля и адресные поля. В нашем случае представлено именно дерево поиска, следовательно, в двоичном дереве это адреса левого и правого поддеревьев. Все это выполняется вот так:

type uk=^derev;

derev=record

inf:string;

cen:integer;

cena:integer;

im:string;

l,r:uk;

spisok:ukaz;

end;

Далее, в разделе переменных Var мы объявляем все переменные, которые будут задействованы в нашей программе:

var root:uk;

Затем мы делаем очень важную процедуру, которую необходимо сделать в самом начале нашей программы – Инициализация дерева:

Procedure Init(var root:Uk);

begin

root:=nil;

end;

Затем мы приступаем к основным задачам программы. К ним относится – Поиск по названию цветка:

procedure poisk_imja(var p:uk);

var g:ukaz;

begin

if p<> nil then

begin

poisk_imja(p^.r);

g:=p^.spisok;

while g<>nil do

begin

if g^.imja=s then

begin

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_imja(p^.l) ;

if fl=false then writeln(' Такого Цветка Нет !');

if s<p^.im then poisk_imja(p^.l)

else poisk_imja(p^.r);

end;

end;

Поиск по стране поставщику:

procedure poisk_strana(var p:uk);

var g:ukaz;

begin

if p<> nil then

begin

poisk_strana(p^.r);

g:=p^.spisok;

while g<>nil do

begin

if g^.strana=f then

begin

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_strana(p^.r);

end;

if fl=false then writeln(' Из Такой Страны Цветов Нет !');

end;

Поиск по цене цветов в магазине:

procedure poisk_cena(p:uk);

var g:ukaz;

begin

if p<> nil then

begin

poisk_cena(p^.l);

g:=p^.spisok;

while g<>nil do

begin

if g^.cena=k then

begin

writeln(p^.im);

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_cena(p^.r);

end;

if fl=false then writeln(' По Такой Цене Цветов Нет !'); end;

Поиск по наличию цветов в магазине:

procedure poisk_koli4estvo(p:uk);

var g:ukaz;

koli4estvo:integer;

begin

if p<> nil then

begin

poisk_koli4estvo(p^.l);

g:=p^.spisok;

while g<>nil do

begin

if g^.koli4estvo=m then

begin

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_koli4estvo(p^.r);

end;

if fl=false then writeln('Столько Цветов Нет !');

end;

Затем мы делаем обход дерева, чтобы наши записи были не спутаны и отсортированы. Дерево, в нашем случае, мы обойдем с помощью обхода:

Сверху вниз (preorder): вершина, левое поддерево, правое поддерево.

Procedure PREORDER(var p:Uk);

Begin

if p<>nil then

begin

writeln(p^.inf);

PREORDER(p^.l);

PREORDER(p^.r);

end;

End;

Так же, мы позаботились и о том, чтобы вывести наше дерево на экран монитора, но не просто вывести, а вывести: По цене цветов, по их названию, по количеству штук, по стране поставщику.

procedure vivod(p:uk);

var g:ukaz;

begin

if p<>nil then

begin

vivod(p^.r);

g:=p^.spisok;

writeln(p^.im);

while g<>nil do

begin

writeln(g^.imja:5);

writeln(g^.strana:5);

writeln(g^.cena:5);

writeln(g^.koli4estvo:5);

g:=g^.next;

end;

vivod(p^.r);

end;

end;

begin

writeln(' Вывод По Цене --- ');

readln(k);

poisk_cena(root);

writeln(' Вывод По Имени --- ');

readln(s);

poisk_imja(root);

writeln(' Вывод По Количеству Штук --- ');

readln(m);

poisk_koli4estvo(root);

writeln(' Вывод По Стране --- ');

readln(f);

poisk_strana(root);

end;

Так же, есть и вывод в файл для простоты и удобства действий:

procedure vivod_v_fail(p:uk);

var g:ukaz;

begin

if p<>nil then

begin

vivod_v_fail(p^.l);

g:=p^.spisok;

while g<>nil do

begin

writeln(x,g^.imja:3);

writeln(x,g^.strana:3);

writeln(x,g^.koli4estvo:3);

writeln(x,g^.cena:3);

g:=g^.next;

end;

vivod_v_fail(p^.r);

end;

end;

Теперь, разложив программу на составляющие части, мы делаем меню и подменю нашей программы:

procedure menu1;

begin

writeln( ' МЕНЮ : ');

writeln(' 1 Добавление Новой Записи');

writeln(' 2 Поиск');

writeln(' 3 Редактирование ');

writeln(' 4 Вывод ');

writeln(' 5 Сохранение В Файл ');

writeln(' 6 Сохранение Базы ');

end;

procedure podmenu;

begin

writeln(' 1 поиск по имени');

writeln(' 2 поиск по стране');

writeln(' 3 поиск по цене');

writeln(' 4 поиск по количеству');

end;

procedure podmenu2;

begin

writeln('1 - Введите имя цветка');

poisk_imja(root);

writeln(' 2 - Введите количество штук');

poisk_koli4estvo(root);

end;

Доделываем необходимые действия и всё - наша программа готова! Вот так, подробно разработав, описав и разобрав наш магазин, мы создали этот мини-шедевр.

Листинг программы

Program Cvetochny_Magazin;

uses crt;

type ukaz=^spisok;

spisok=record

imja:string;

strana:string;

cena,koli4estvo:integer;

next:ukaz;

end;

type uk=^derev;

derev=record

inf:string;

cen:integer;

cena:integer;

im:string;

l,r:uk;

spisok:ukaz;

end;

var root:uk;

p:ukaz;

a,m:integer;

k:byte;

f,s:string;

fl:boolean;

x:text;

procedure Init(var root:Uk);

begin

root:=nil;

end;

procedure add_1(var temp:uk);

var w:ukaz;

begin

new(w);

with w^ do

begin

write(' Введите Имя Цветка ---> ');

readln(imja);

write(' Введите Страну ---> ');

readln(strana);

write( ' Введите Цену ---> ');

readln(cena);

write( ' Введите Количество Штук ---> ');

readln(koli4estvo);

next:=nil;

end;

if temp^.spisok=nil then

temp^.spisok:=w

else

begin

w^.next:=temp^.spisok;

temp^.spisok:=w;

end;

end;

procedure add(var root:uk);

var p,p1,w:uk;

n:integer;

begin

new(w);

with w^ do

begin

spisok:=nil;

l:=nil;

r:=nil;

end;

read(n);

while n=1 do

begin

add_1(w);

readln(n);

end;

if root=nil then root:=w

else

begin

p:=root;

while p<>nil do

begin

p1:=p;

if w^.cen<p^.cen then p:=p^.l

else p:=p^.r;

end;

if w^.cena<p1^.cena then p1^.l:=w

else p1^.r:=w;

end;

end;

procedure poisk_imja(var p:uk);

var g:ukaz;

begin

if p<> nil then

begin

poisk_imja(p^.r);

g:=p^.spisok;

while g<>nil do

begin

if g^.imja=s then

begin

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_imja(p^.l) ;

if fl=false then writeln(' Такого Цветка Нет !');

if s<p^.im then poisk_imja(p^.l)

else poisk_imja(p^.r);

end;

end;

procedure poisk_strana(var p:uk);

var g:ukaz;

begin

if p<> nil then

begin

poisk_strana(p^.r);

g:=p^.spisok;

while g<>nil do

begin

if g^.strana=f then

begin

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_strana(p^.r);

end;

if fl=false then writeln(' Из Такой Страны Цветов Нет !');

end;

procedure poisk_cena(p:uk);

var g:ukaz;

begin

if p<> nil then

begin

poisk_cena(p^.l);

g:=p^.spisok;

while g<>nil do

begin

if g^.cena=k then

begin

writeln(p^.im);

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_cena(p^.r);

end;

if fl=false then writeln(' По Такой Цене Цветов Нет !');

end;

procedure poisk_koli4estvo(p:uk);

var g:ukaz;

koli4estvo:integer;

begin

if p<> nil then

begin

poisk_koli4estvo(p^.l);

g:=p^.spisok;

while g<>nil do

begin

if g^.koli4estvo=m then

begin

writeln(g^.imja:3);

writeln(g^.strana:3);

writeln(g^.koli4estvo:3);

writeln(g^.cena:3);

fl:=true;

end;

g:=g^.next;

end;

poisk_koli4estvo(p^.r);

end;

if fl=false then writeln('Столько Цветов Нет !');

end;

Procedure PREORDER(var p:Uk);

Begin

if p<>nil then

begin

writeln(p^.inf);

PREORDER(p^.l);

PREORDER(p^.r);

end;

End;

procedure vivod(p:uk);

var g:ukaz;

begin

if p<>nil then

begin

vivod(p^.r);

g:=p^.spisok;

writeln(p^.im);

while g<>nil do

begin

writeln(g^.imja:5);

writeln(g^.strana:5);

writeln(g^.cena:5);

writeln(g^.koli4estvo:5);

g:=g^.next;

end;

vivod(p^.r);

end;

end;

procedure vivod_v_fail(p:uk);

var g:ukaz;

begin

if p<>nil then

begin

vivod_v_fail(p^.l);

g:=p^.spisok;

while g<>nil do

begin

writeln(x,g^.imja:3);

writeln(x,g^.strana:3);

writeln(x,g^.koli4estvo:3);

writeln(x,g^.cena:3);

g:=g^.next;

end;

vivod_v_fail(p^.r);

end;

end;

procedure menu1;

begin

writeln( ' МЕНЮ : ');

writeln(' 1 Добавление Новой Записи');

writeln(' 2 Поиск');

writeln(' 3 Вывод Базы ');

writeln(' 4 Сохранение В Файл ');

writeln(' 5 Выход ');

end;

procedure podmenu;

begin

writeln(' 1 поиск по имени');

writeln(' 2 поиск по стране');

writeln(' 3 поиск по цене');

writeln(' 4 поиск по количеству');

end;

begin

fl:=false;

repeat

menu1;

readln(a);

case a of

1:add(root);

2:begin

repeat

podmenu;

readln(a);

case a of

1:begin

writeln(' Введите Имя Цветка ---> ');

readln(s);

poisk_imja(root);

preorder(root);

end;

2:begin

writeln(' Введите Страну ---> ');

readln(f);

poisk_strana(root);

end;

3:begin

writeln(' Введите Цену ---> ');

poisk_cena(root);

readln(k);

end;

4:begin

writeln(' Введите Количество ---> ');

poisk_koli4estvo(root);

readln(m);

end;

end;

until a>4;

end;

3:begin

writeln(' Вывод По Цене: Введите Цену --- ');

readln(k);

poisk_cena(root);

writeln(' Вывод По Имени: ВВедите Название Цветка --- ');

readln(s);

poisk_imja(root);

writeln(' Вывод По Количеству Штук: ВВедите Количество Цветов --- ');

readln(m);

poisk_koli4estvo(root);

writeln(' Вывод По Стране: ВВедите Страну --- ');

readln(f);

poisk_strana(root);

end;

4:begin

assign(x,' Цветочный Магазин.txt ');

rewrite(x);

vivod_v_fail(root);

close(x);

end;

5:vivod(root);

end;

until a=5;

end.

5. Протокол выполнения программы Главное Меню:

Добавление Новой Записи:

Поиск:

Вывод Базы:

Выход:

Список используемой литературы:

1. Г.С. Иванова. Основы программирования. М.: Издательство МГТУ им. Н.Э. Баумана. 2001 г.

2. А.в. Могилев, Н.И. Пак, Е.К. Хеннер. Информатика: Учеб. пособие.М.: Изд. Центр «Академия», 2000 г.

3. Информатика: Базовый курс / С.В. Симонович и др. – СПб.: Питер, 2001 г.

4. Климова Л.М. Pascal 7.0. Практическое программирование. Решение типовых задач. – М.: КУДИЦ-ОБРАЗ, 2000 г.