Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 12.02.2013, 14:58
sandysman sandysman вне форума
Новичок
 
Регистрация: 27.03.2012
Сообщения: 60
Репутация: 10
По умолчанию B+деревья

Всем здравствуйте, проходим тринарные деревья, а литературы по ним катастрофически мало, может кто-нибудь накидать литературы, где есть описание этой темы, примеры работы с такими деревьями, и подобное. И есть задача по В-дереву его нужно в В+ переделать и нужно чтобы вся информация была в листьях,а в узлах ключи...и листья в стек связать, и что бы был вывод дерева, ввод листьев и удаление листьев. Есть код


препод говорит, что у меня ошибка ,хотя все работает в принципе, помогите найти пожалуйста.
Ответить с цитированием
  #2  
Старый 12.02.2013, 14:59
sandysman sandysman вне форума
Новичок
 
Регистрация: 27.03.2012
Сообщения: 60
Репутация: 10
По умолчанию

Код:
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
sandysman sandysman вне форума
Новичок
 
Регистрация: 27.03.2012
Сообщения: 60
Репутация: 10
По умолчанию

Код:
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.
Ответить с цитированием
  #4  
Старый 12.02.2013, 15:00
sandysman sandysman вне форума
Новичок
 
Регистрация: 27.03.2012
Сообщения: 60
Репутация: 10
По умолчанию

Это все код задачи, которую я решал.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 16:14.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter