|
|
|
|
#1
12.02.2013, 14:58
|
|||
|
|||
B+деревья
Всем здравствуйте, проходим тринарные деревья, а литературы по ним катастрофически мало, может кто-нибудь накидать литературы, где есть описание этой темы, примеры работы с такими деревьями, и подобное. И есть задача по В-дереву его нужно в В+ переделать и нужно чтобы вся информация была в листьях,а в узлах ключи...и листья в стек связать, и что бы был вывод дерева, ввод листьев и удаление листьев. Есть код
препод говорит, что у меня ошибка ,хотя все работает в принципе, помогите найти пожалуйста. |
|
#2
12.02.2013, 14:59
|
|||
|
|||
|
Код:
program another;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
//константы
const MAX=9999;
Help='Б-деревом (B-Tree) называется дерево, устроенное следующим образом:'+#13#10+
' 1) Каждая вершина содержит поля, в которых хранятся: количество n ключей,'#13#10+
' содержащихся в ней, сами ключи в неубывающем порядке и булевское значе-'#13#10+
' ние, истинное, когда вершина является листом. Внутренние вершины кроме'#13#10+
' того содержат n+1 указателей на её детей. У листьев детей нет, так что'#13#10+
' эти поля для них не определены.'#13#10+
' 2) Ключи, очевидно, служат границами, разделяющими значения ключей в под-'#13#10+
' деревьях.'#13#10+
' 3) Все листья находятся на одной глубине, называемой высотой дерева.'#13#10+
' 4) Число ключей, хранящихся в одной вершине, ограничено и сверху, и снизу.'#13#10+
' Границы задаются единым для всего дерева числом T>2, которое называется'#13#10+
' минимальной степенью (minimum degree) Б-дерева. При этом каждая вершина,'#13#10+
' кроме корня,содержит не менее T-1 и не более 2T-1 ключей. Соответственно,'#13#10+
' каждая вершина, кроме корня, имеет от T до 2T детей. Вершину, имеющую '#13#10+
' ровно 2T детей, назовем полной (full).'#13#10+
#13#10+
' В простейшем случае T=2, тогда у каждой внутренней вершины 2, 3 '#13#10+
' ребенка, и мы получаем так называемое 2-3-дерево (2-3-4 tree).'#13#10;
//--------------
//типы
type
TTree=^TTreeElem;
TTreeList=record
key:integer;
kid:TTree;
end;
TTreeElem=record
count:integer;
isLeave:boolean;
keys:array of TTreeList;
end;
//----------------------
//глобальные переменные
var Degree:integer=2; //минимальная степень Б-дерева по-умолчанию
Root:TTree=nil; //корень
//---------------------------------------------------------------------------
//------------------------------блок подпрограмм-----------------------------
procedure writex(x:string); //вывод русской строки
var z:string;
begin
setlength(z,length(x));
CharToOem(PChar(x),PChar(z));
write(z);
end;
procedure writelnx(x:string); //вывод русской строки и переход на новую
var z:string;
begin
setlength(z,length(x));
CharToOem(PChar(x),PChar(z));
writeln(z);
end;
function Search(x:integer; Tree:TTree; var index:integer):TTree;
var i:integer; //поиск в дереве
F:boolean;
begin
result:=nil;
F:=false;
i:=Tree^.Count-1;
while (x<Tree^.keys[i].Key) and (not F) do
begin
if Tree^.keys[i].Kid<>nil then
if ((i>0) and (x>Tree^.keys[i-1].Key)) or (i=0) then //рекурсивный заход
result:=Search(x,Tree^.keys[i].Kid,index); //только при необходимости
if (result<>nil) then
F:=true
else i:=i-1;
end;
if not F then
begin
if i>-1 then
if x=Tree^.keys[i].Key then begin result:=Tree; index:=i; end;
end;
end;
function InsertKey(x:integer;T:TTree):TTree;forward;
//вставка поддерева в дерево (при удалении)
procedure InsertTree(Tree:TTree; var ToTree:TTree);
var i:integer;
begin
if Tree<>nil then
begin
i:=Tree^.Count-1;
while(i>=0)do
begin
if Tree^.keys[i].Key<MAX then
begin
ToTree:=InsertKey(Tree^.keys[i].Key,ToTree);
end;
if Tree^.keys[i].Kid<>nil then InsertTree(Tree^.keys[i].Kid,ToTree);
i:=i-1;
end;
end;
end;
function TerminateTree(Tree:TTree):TTree; //уничтожение дерева
var i:integer;
begin
result:=nil;
if Tree<>nil then
begin
i:=Tree^.Count-1;
while(i>=0)do
begin
if Tree^.keys[i].kid<>nil then Tree^.keys[i].kid:=TerminateTree(Tree^.keys[i].kid);
i:=i-1;
end;
Setlength(Tree^.keys,0);
FreeMem(Tree,sizeof(TTreeElem));
Tree:=nil;
result:=Tree;
end;
end;
function Parent(Rt,T:TTree;var ind:integer):TTree;forward; //опережающее
//определение
//поиска родителя
function DeleteFromTree(x:integer;Tree:TTree;var R:boolean):TTree;
var i,j:integer; //удаление элемента, R -флаг реорганизации дерева
ST:TTree; //если удален элемент полностью - это
begin //приводит к нарушению уровневой структуры, нужна
result:=Tree; //перестройка всего дерева
R:=false;
if Tree<>nil then
begin
i:=Tree^.Count-1; //рекурсивно ищем элемент
while(i>=0)and(Tree<>nil)do
begin
if Tree^.keys[i].kid<>nil then
Tree^.keys[i].kid:=DeleteFromTree(x,Tree^.keys[i].kid,R);
if x=Tree^.keys[i].Key then
BEGIN //нашли удаляемый
if Tree^.isLeave then //это лист
begin
if Tree^.Count>1 then //есть много элементов
begin
for j:=i to Tree^.Count-2 do //сжимаем
Tree^.keys[j]:=Tree^.keys[j+1];
Tree^.Count:=Tree^.Count-1;
SetLength(Tree^.keys,Tree^.Count);
end
else //это лист и в нем мы удаляем последний - реорганизация
begin
Tree^.keys[i].key:=MAX;
R:=true;
end;
end
else
if Tree^.Count>2 then //это не лист, но в нем есть много элементов
begin
ST:=Tree^.keys[i].Kid; //массив имеет более 1 элемента
for j:=i to Tree^.Count-2 do //сжимаем
Tree^.keys[j]:=Tree^.keys[j+1];
Tree^.Count:=Tree^.Count-1;
SetLength(Tree^.keys,Tree^.Count);
if ST<>nil then //есть потомок и если текущий (на месте удаленного)
begin //не имеет потомков - прицепляем, иначе - перестраиваем текущую вершину -->
if Tree^.keys[i].kid=nil then Tree^.keys[i].kid:=ST
else
InsertTree(ST,Tree) // --> добавлением в нее всех потомков удаленного
end;
end
else //удаляем элемент полностью - реорганизация
begin
Tree^.keys[i].key:=MAX;
R:=True;
end;
i:=0;
result:=Tree;
END;
i:=i-1;
end;
end;
end;
function Parent(Rt,T:TTree;var ind:integer):TTree; //поиск родителя
var i:integer;
begin
i:=0;
result:=nil;
while (Rt^.keys[i].kid<>T) and (i<Rt^.count) and (Rt<>T) do
begin
if Rt^.keys[i].kid<>nil then result:=Parent(Rt^.keys[i].kid,T,ind);
if result<>nil then break;
inc(i);
end;
if i<Rt^.count then
if (Rt^.keys[i].kid=T) then begin result:=Rt;ind:=i;end;
end;
function Split(T:TTree):TTree; //разделение вершины (рекурсивное)
var T1,T2,T3:TTree;
var i,j,m,d,k:integer;
begin
new(T2);
T2^.count:=Degree-1;
SetLength(T2^.keys,T2^.count);
T2^.isLeave:=true;
for i:=0 to Degree-2 do
begin
T2^.keys[i]:=T^.keys[i];
if T^.keys[i].kid<>nil then T2^.isLeave:=false;
end;
new(T3);
T3^.count:=T^.count-Degree;
SetLength(T3^.keys,T3^.count);
T3^.isLeave:=true;
for i:=Degree to T^.count-1 do
begin
T3^.keys[i-Degree]:=T^.keys[i];
if T^.keys[i].kid<>nil then T3^.isLeave:=false;
end;
m:=Degree-1;
if T^.keys[m].kid<>nil then
begin
T2^.count:=T2^.count+1;
SetLength(T2^.keys,T2^.count);
T2^.keys[T2^.count-1].kid:=T^.keys[m].kid;
T2^.keys[T2^.count-1].key:=MAX;
end;
j:=T^.keys[m].key;
T1:=Parent(Root,T,i);
if T1<>nil then
begin
if T1^.keys[T1^.count-1].key=MAX then D:=2*Degree else
D:=2*Degree-2;
if T1^.count>=D then
T1:=Split(T1)
else
begin
i:=0;
while (j>T1^.keys[i].key)and(i<T1^.count) do inc(i);
if i<=T1^.count then //insert to middle or start
begin
T1^.Count:=T1^.count+1;
SetLength(T1^.keys,T1^.count);
for k:=T1^.count-1 downto i+1 do
T1^.keys[k]:=T1^.keys[k-1];
T1^.keys[i].key:=j;
T1^.keys[i].kid:=T2;
T1^.keys[i+1].kid:=T3;
T1^.isLeave:=false;
end
end
end
else
begin
SetLength(T^.keys,2);
T^.count:=2;
T^.isLeave:=false;
T^.keys[0].key:=j;
T^.keys[0].kid:=T2;
T^.keys[1].kid:=T3;
T^.keys[1].key:=MAX;
end;
result:=T;
end; |
|
#3
12.02.2013, 14:59
|
|||
|
|||
|
Код:
function InsertKey(x:integer;T:TTree):TTree;
var i,j,D:integer;
begin
if T=nil then
begin
new(T);
T^.count:=1;
T^.isLeave:=true;
SetLength(T^.keys,1);
T^.keys[0].key:=x;
T^.keys[0].kid:=nil;
Root:=T;
end
else
begin
if T^.keys[T^.count-1].key=MAX then
D:=2*Degree
else
D:=2*Degree-2;
if T^.count>D then
begin
T:= Split(T);
result:=InsertKey(x,Root)
end
else
begin
i:=0;
while (x>T^.keys[i].key)and(i<T^.count) do inc(i);
if x<>T^.keys[i].key then
begin
if i<T^.count then //insert to middle or start
begin
if (T^.keys[i].kid<>nil)then
result:=InsertKey(x,T^.keys[i].kid)
else
begin
T^.Count:=T^.count+1;
SetLength(T^.keys,T^.count);
for j:=T^.count-1 downto i+1 do
T^.keys[j]:=T^.keys[j-1];
T^.keys[i].key:=x;
T^.keys[i].kid:=nil;
end;
end
else //insert to end
if i=T^.count then
begin
T^.count:=T^.count+1;
SetLength(T^.keys,T^.count);
T^.keys[i].key:=x;
T^.keys[i].kid:=nil;
end;
end;
end;
end;
result:=T;
end;
procedure PrintTree(Tree:TTree;Pos:integer); //вывод дерева ПКЛ обходом
var i,j:integer;
begin
if Tree<>nil then
begin
i:=Tree^.Count-1;
while(i>=0)do
begin
if Tree^.keys[i].key<MAX then
begin
for j:=1 to Pos do write(' ');
writeln(Tree^.keys[i].key);
end;
if Tree^.keys[i].kid<>nil then PrintTree(Tree^.keys[i].kid,Pos+5);
i:=i-1;
end;
end;
end;
procedure Reorganize(var Tree:TTree); //перестроение дерева
var s:array of integer;
i:integer;
procedure ReBuildTree(Tree:TTree); //построение нового на основе
var i:integer; //старого без удаляемого
begin
if Tree<>nil then
begin
i:=Tree^.Count-1;
while(i>=0)do
begin
if Tree^.keys[i].key<MAX then
begin
setlength(s,length(s)+1);
s[length(s)-1]:=Tree^.keys[i].key;
end;
write('.');
sleep(10);
if Tree^.keys[i].kid<>nil then ReBuildTree(Tree^.keys[i].kid);
i:=i-1;
end;
end;
end;//get tree
begin
writeln;
writex('Производим реорганизацию дерева...');
setlength(s,0);
ReBuildTree(Tree);
writeln;
Tree:=TerminateTree(Tree);
for i:=0 to length(s)-1 do
Tree:=InsertKey(s[i],Tree);
writeln;
writelnx('Дерево реорганизовано!');
writeln;
end;
var M1,M2:byte;
i,j,MaxG,k,c,n:integer;
R:boolean; //флаг реорганизации при удалении
S:TTree; //для поиска
begin
// writeln(' ----------- ');
writelnx('| Б-деревья |');
// writeln(' ----------- ');
writeln;
repeat
writelnx('Выберите пункт меню:');
//writeln('^^^^^^^^^^^^^^^^^^^^');
writelnx(' 1) Создание Б-дерева');
writelnx(' 2) Просмотр дерева');
//writelnx(' 3) Поиск в Б-дереве');
writelnx(' 4) Изменение дерева');
//writelnx(' 5) Выход (0-помощь)');
write(' : ');
readln(M1);
case M1 of
0:begin
writelnx(Help);
writelnx('Нажмите <Enter>...');
readln;
end;
1:begin
repeat
writeln;
writelnx('Создание Б-дерева:');
writelnx(' 1) Случайными числами');
writelnx(' 2) Ввод элементов вручную');
writex(' 3) Изменить степень (текущая T=');writeln(Degree,')');
// writelnx(' 4) Возврат');
write(' : ');
readln(M2);
if (M2>0) and (M2<4) then Root:=TerminateTree(Root);
case M2 of
1:begin
writex('Введите желаемое количество элементов (узлов) Б-дерева:');
readln(MaxG);
// writex('Процесс создания отследить (1-да, 2-нет)? ');
// readln(j);
j:=2;
randomize;n:=0;
for i:=1 to MaxG do
begin
c:=random(1000);
if (j=1) then begin writex('Подаем >>> ');writeln(c); end;
if Root<>nil then
begin
if Search(c,Root,k)=nil then
Root:=InsertKey(c,Root)
else
begin
if j=1 then writelnx('Такое значение уже пристутствует в дереве!')
else n:=n+1
end
end
else Root:=InsertKey(c,Root);
if (j=1) then
begin
writex('нажмите ввод...');readln;
writelnx('Б - ДЕРЕВО');
PrintTree(Root,3);
// writelnx('---------------------------------------------------');
end;
end;
if j<>1 then writelnx('Повторилось '+IntToStr(n)+' значений');
writelnx('Дерево готово.');
end;
2:begin
writelnx('Вводите числа одно за одним через пробел или <Enter>.');
writelnx('По окончании - введите -1');
read(j);
while (j<>-1) do
begin
if Root=nil then Root:=InsertKey(j,Root) else
if Search(j,Root,c)=nil then
Root:=InsertKey(j,Root)
else
writelnx('Есть уже такое значение');
writelnx('Б - ДЕРЕВО');
PrintTree(Root,3);
//writelnx('---------------------------------------------------');
read(j);
end;
writelnx('Дерево готово');
end;
3:begin
writelnx('Изменение минимальной степени дерева:');
writex('Введите новое значение(текущее T=');write(Degree,'): ');
readln(Degree);
end;
end;
until M2<>3;
end;
2:if Root=nil then writelnx('>>>>>>>>>>>>>>>>> Дерево не создано!') else
begin
writelnx('-------------------Б - ДЕРЕВО----------------------');
PrintTree(Root,3);
//writelnx('---------------------------------------------------');
end;
3:if Root=nil then writelnx('>>>>>>>>>>>>>>>>> Дерево не создано!') else begin
writex('Введите искомое значение: ');readln(j);
S:=Search(j,Root,i);
if S<>nil then
begin
writelnx('Элемент найден!');
writex('Значение: ');writeln(S^.keys[i].key);
if S^.keys[i].kid<>nil then
begin
writelnx('Потомки:');
PrintTree(S^.keys[i].kid,3);
end else
writelnx('Потомков нет у данного элемента');
end else writelnx('Нет такого значения!');
end;
4:if Root=nil then writelnx('>>>>>>>>>>>>>>>>> Дерево не создано!') else begin
repeat
writelnx('Выберите пункт меню:');
writelnx('1) Вставка');
writelnx('2) Удаление');
writelnx('3) Возврат');
write(' : ');
readln(j);
case j of
1:begin
writelnx('Вводите ключи(числа менее '+IntToStr(MAX)+') (-1 - завершить ввод):');
readln(k);
while(k<>-1)do
begin
if Root=nil then Root:=InsertKey(k,Root) else
if Search(k,Root,c)=nil then
Root:=InsertKey(k,Root)
else writelnx('Есть уже такое значение');
writeln;
writelnx('-------------------Б - ДЕРЕВО----------------------');
PrintTree(Root,3);
writelnx('---------------------------------------------------');
writelnx('Еще? (-1 - конец)');
readln(k);
end;
j:=3;
end;
2:
begin
writex('Введите значение для удаления: ');
readln(k);
S:=Search(k,Root,i);
if S<>nil then
begin
Root:=DeleteFromTree(k,Root,R);
if R then
Reorganize(Root);
writeln;
writelnx('-------------------Б - ДЕРЕВО----------------------');
PrintTree(Root,3);
writelnx('---------------------------------------------------');
writelnx('Элемент успешно удален!');
end
else writelnx('Элемент не найден!');
j:=3;
end;
end;//case
until j=3;
end;
end;
until M1=5;
Root:=TerminateTree(Root);
end. |
Линейный вид
