algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Drzewo - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 2
SłabyŚwietny
Nadesłany przez dariuszlewinski, 13 czerwca 2011 01:25
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

drzewo_1_d.pas:
//Drzewo czerwono-czarne
//www.algorytm.org

program drzewo_red_black;
type kolor=(red,black);
drzewo=^element_drzewa;
        element_drzewa=record
                         key:integer; {klucz, w tym przypadku liczba}
                         left,right,parent:drzewo; {parent- rodzic danego wezla drzewa}
                         color:kolor;
                       end;


procedure Left_Rotate(var T:drzewo; var x:drzewo);
var y:drzewo;
begin
  y:=x^.right;
  x^.right:=y^.left;
  if (y^.left<>nil) then y^.left^.parent:=x;
  y^.parent:=x^.parent;
  if (x^.parent=nil) then T:=y else
  if x=x^.parent^.left then x^.parent^.left:=y else x^.parent^.right:=y;
  y^.left:=x;
  x^.parent:=y;
end;


procedure Right_Rotate(var T:drzewo;var x:drzewo);
var y:drzewo;
begin
   y:=x^.left;
   x^.left:=y^.right;
   if (y^.right<>nil) then y^.right^.parent:=x;
   y^.parent:=x^.parent;
   if (x^.parent=nil) then T:=y else
   if (x=x^.parent^.right) then x^.parent^.right:=y else
   x^.parent^.left:=y;
   y^.right:=x;
   x^.parent:=y;
end;


procedure BST_Insert(var T:drzewo; var z:drzewo);
var x,y,el:drzewo;
begin
  y:=nil;
  x:=T;
  while (x<>nil) do
  begin
    y:=x;
    if (z^.key<x^.key) then x:=x^.left else x:=x^.right;
  end;
  z^.parent:=y;
  if (y=nil) then T:=z else if (z^.key<y^.key) then y^.left:=z else y^.right:=z;
end;

procedure RB_Insert(var T:drzewo;var z:drzewo);
var y:drzewo;
begin
  BST_insert(T,z);
  z^.color:=red;
  while((z<>T) and  (z^.parent^.color=red)) do
  begin
    if(z^.parent=z^.parent^.parent^.left) then
    begin
      y:=z^.parent^.parent^.right;
      if(y^.color=red) then
      begin
	z^.parent^.color:=black;
	y^.color:=black;
	z^.parent^.parent^.color:=red;
	z:=z^.parent^.parent;
      end
      else if(z=z^.parent^.right) then
      begin
	z:=z^.parent;
	left_rotate(T,z);
      end
      else
      begin
	z^.parent^.color:=black;
	z^.parent^.parent^.color:=red;
	right_rotate(T,z^.parent^.parent);
      end
    end
    else
    begin
      y:=z^.parent^.parent^.left;
      if(y^.color=red) then
      begin
	z^.parent^.color:=black;
	y^.color:=black;
	z^.parent^.parent^.color:=red;
	z:=z^.parent^.parent;
      end
      else if(z=z^.parent^.left) then
      begin
	z:=z^.parent;
	left_rotate(T,z);
      end
      else
      begin
	z^.parent^.color:=black;
	z^.parent^.parent^.color:=red;
	right_rotate(T,z^.parent^.parent);
      end
    end
  end;
  T^.color:=black;
end;




procedure wypisz(var T:drzewo);
begin
  if (T<>nil) then
  begin
    wypisz(T^.left);
    writeln(T^.key,',',T^.color);
    wypisz(T^.right);
  end;
end;


var D,d1:drzewo;
    i,ile,liczba:integer;
begin
  write('ile wstawiamy ');
  readln (ile);
  for i:=1 to ile do
  begin
    write('Podaj liczbe ');
    readln(liczba);
    new(d1);
    d1^.key:=liczba;
    d1^.left:=nil;
    d1^.right:=nil;
    RB_insert(D,d1);
  end;
  wypisz(D);
  readln;
end.


Dodaj komentarz