type
  PRBTnode = ^RBTnode;
  RBTnode  = record
    up    : PBSTnode;
    left  : PBSTnode;
    right : PBSTnode;
    key   : integer;
    color : char;
    Data: typ_danych;
  end;

struct RBTnode
{
  RBTnode * up;
  RBTnode * left;
  RBTnode * right;
  int key;
  char color;
  typ_danych data;
};

Type RBTnode
  up    As RBTnode Ptr
  left  As RBTnode Ptr
  right As RBTnode Ptr
  key   As Integer
  color As String * 1
  data  As typ_danych
End Type

// Drzewo czerwono-czarne
// Data: 11.06.2013
// (C)2013 mgr Jerzy Wałaszek
//---------------------------

program RedBlackTree;

// Liczba węzłów
const MAXN = 30;

// Typ węzłów drzewa RBT
type
  PRBTnode = ^RBTnode;
  RBTnode  = record
    up, left, right : PRBTnode;
    key   : integer;
    color : char;
  end;

// Definicja typu obiektowego RBtree
RBtree = object
  private
    // Węzeł strażnika
    S    : RBTnode;
    // Korzeń drzewa czerwono-czarnego
    root : PRBTnode;
    // Łańcuchy do znaków ramek
    cr, cl, cp : string;

    // Wypisuje rekurencyjnie drzewo
    procedure t_print_rbt(sp, sn : string;
                              p : PRBTnode);
    // Usuwa rekurencyjnie drzewo
    procedure dfs_release(p : PRBTnode);
    // Rotacja w lewo względem A
    procedure rot_l(A : PRBTnode);
    // Rotacja w prawo względem A
    procedure rot_r(A : PRBTnode);
    // Wyszukuje najmniejszy węzeł w p
    function min_rbt(p : PRBTnode) : PRBTnode;
    // Wyszukuje następnik p
    function succ_rbt(p : PRBTnode) : PRBTnode;

  public
    constructor init;
    destructor  destroy;
    // Wypisuje drzewo
    procedure print_rbt();
    // Wyszukuje węzeł o kluczu k
    function find_rbt(k : integer) : PRBTnode;
    // Wstawia węzeł o kluczu k
    procedure insert_rbt(k : integer);
    // Usuwa węzeł X
    procedure remove_rbt(X : PRBTnode);
end;

// Konstruktor drzewa
//-------------------
constructor RBtree.init;
begin
  // Inicjujemy łańcuchy do ramek
  cr := #218#196;
  cl := #192#196;
  cp := #179#32;
  // Inicjujemy strażnika
  S.color := 'B';
  S.up    := @S;
  S.left  := @S;
  S.right := @S;
  // Korzeń wskazuje strażnika
  root    := @S;
end;

// Destruktor drzewa
//------------------
destructor RBtree.destroy;
begin
  // Rekurencyjnie usuwamy węzły
  dfs_release(root);
end;

// Usuwa rekurencyjnie
// drzewo czerwono-czarne
//-----------------------
procedure RBtree.dfs_release(p : PRBTnode);
begin
  if p <> @S then
  begin
    // usuwamy lewe poddrzewo
    dfs_release(p^.left);
    // usuwamy prawe poddrzewo
    dfs_release(p^.right);
    // usuwamy sam węzeł
    dispose(p);
  end;
end;

// Wypisuje zawartość drzewa
//--------------------------
procedure RBtree.t_print_rbt(sp, sn : string;
                                   p : PRBTnode);
var
  t : string;
  i : integer;
begin
  if p <> @S then
  begin
    t := sp;
    if sn = cr then
      t[length(t)-1] := ' ';
    t_print_rbt(t+cp, cr, p^.right);
    t := Copy(sp, 1, length(sp)-2);
    for i := 1 to length(t) do
      write(char(ord(t[i])));
    for i := 1 to length(sn) do
      write(char(ord(sn[i])));
    writeln(p^.color, ':', p^.key);
    t := sp;
    if sn = cl then
      t[length(t)-1] := ' ';
    t_print_rbt(t+cp, cl, p^.left);
  end;
end;

// Wypisuje zawartość drzewa
//--------------------------
procedure RBtree.print_rbt();
begin
  t_print_rbt ('', '', root);
end;

// Wyszukuje węzeł o kluczu k
// Jeśli węzeł nie zostanie
// znaleziony, to zwraca
// wskazanie puste nil
//---------------------------
function RBtree.find_rbt(k : integer)
                            : PRBTnode;
var
  p : PRBTnode;
begin
  p := root;
  while(p <> @S) and (p^.key <> k) do
      if k < p^.key then p := p^.left
      else               p := p^.right;
  if p = @S then find_rbt := nil
  else           find_rbt := p;
end;

// Wyszukuje najmniejszy węzeł
// w poddrzewie o korzeniu p
//----------------------------
function  RBtree.min_rbt(p : PRBTnode)
                           : PRBTnode;
begin
  if p <> @S then
    while p^.left <> @S do
      p := p^.left;
  min_rbt := p;
end;

// Zwraca następnik p
//-------------------
function RBtree.succ_rbt(p : PRBTnode)
                           : PRBTnode;
var
  r : PRBTnode;
begin
  succ_rbt := @S;
  if p <> @S then
  begin
    if p^.right <> @S then
      succ_rbt := min_rbt(p^.right)
    else
    begin
      r := p^.up;
      while(r <> @S) and (p = r^.right) do
      begin
        p := r;
        r := r^.up;
      end;
      succ_rbt := r;
    end;
  end;
end;

// Wykonuje rotację w lewo względem A
//-----------------------------------
procedure RBtree.rot_l(A : PRBTnode);
var
  B, p : PRBTnode;
begin
  B := A^.right;
  if B <> @S then
  begin
    p := A^.up;
    A^.right := B^.left;
    if A^.right <> @S then
      A^.right^.up := A;
    B^.left := A;
    B^.up := p;
    A^.up := B;
    if p <> @S then
    begin
      if p^.left = A then
        p^.left := B
      else
        p^.right := B;
    end
    else root := B;
  end;
end;

// Wykonuje rotację w prawo względem A
//------------------------------------
procedure RBtree.rot_r(A : PRBTnode);
var
  B, p : PRBTnode;
begin
  B := A^.left;
  if B <> @S then
  begin
    p := A^.up;
    A^.left := B^.right;
    if A^.left <> @S then
      A^.left^.up := A;
    B^.right := A;
    B^.up := p;
    A^.up := B;
    if p <> @S then
    begin
      if p^.left = A then
        p^.left := B
      else
        p^.right := B;
    end
    else root := B;
  end;
end;

// Wstawia do drzewa
// węzeł o kluczu k
//------------------
procedure RBtree.insert_rbt(k : integer);
var
  X, Y : PRBTnode;
begin
  // Tworzymy nowy węzeł
  new(X);
  // Inicjujemy pola
  X^.left  := @S;
  X^.right := @S;
  X^.up    := root;
  X^.key   := k;
  if X^.up = @S then
    // X staje się korzeniem
    root := X
  else
  // Szukamy liścia
  // do zastąpienia przez X
  while true do
  begin
    if k < X^.up^.key then
    begin
      if X^.up^.left = @S then
      begin
        // X zastępuje lewy liść
        X^.up^.left := X;
        break;
      end;
      X^.up := X^.up^.left;
    end
    else
    begin
      if X^.up^.right = @S then
      begin
        // X zastępuje prawy liść
        X^.up^.right := X;
        break;
      end;
      X^.up := X^.up^.right;
    end;
  end;
  // Węzeł kolorujemy na czerwono
  X^.color := 'R';
  while(X <> root) and (X^.up^.color = 'R') do
  begin
    if X^.up = X^.up^.up^.left then
    begin
      // Y -> wujek X
      Y := X^.up^.up^.right;
      // Przypadek 1
      if Y^.color = 'R' then
      begin
        X^.up^.color     := 'B';
        Y^.color         := 'B';
        X^.up^.up^.color := 'R';
        X := X^.up^.up;
        continue;
      end;
      // Przypadek 2
      if X = X^.up^.right then
      begin
        X := X^.up;
        rot_l(X);
      end;
      // Przypadek 3
      X^.up^.color     := 'B';
      X^.up^.up^.color := 'R';
      rot_r(X^.up^.up);
      break;
    end
    else
    // Przypadki lustrzane
    begin
      Y := X^.up^.up^.left;
      // Przypadek 1
      if Y^.color = 'R' then
      begin
        X^.up^.color     := 'B';
        Y^.color         := 'B';
        X^.up^.up^.color := 'R';
        X := X^.up^.up;
        continue;
      end;
      // Przypadek 2
      if X = X^.up^.left then
      begin
        X := X^.up;
        rot_r(X);
      end;
      // Przypadek 3
      X^.up^.color     := 'B';
      X^.up^.up^.color := 'R';
      rot_l(X^.up^.up);
      break;
    end;
  end;
  root^.color := 'B';
end;

// Usuwa z drzewa węzeł X
//-----------------------
procedure RBtree.remove_rbt(X : PRBTnode);
var
  W, Y, Z : PRBTnode;
begin
  if(X^.left = @S) or
    (X^.right = @S) then
    Y := X
  else
    Y := succ_rbt(X);
  if Y^.left <> @S then
    Z := Y^.left
  else
    Z := Y^.right;
  Z^.up := Y^.up;
  if Y^.up = @S then
    root := Z
  else
    if Y = Y^.up^.left then
      Y^.up^.left  := Z
    else
      Y^.up^.right := Z;
  if Y <> X then X^.key := Y^.key;
  // Naprawa struktury
  // drzewa czerwono-czarnego
  if Y^.color = 'B' then
    while(Z <> root) and (Z^.color = 'B') do
      if Z = Z^.up^.left then
      begin
        W := Z^.up^.right;
        // Przypadek 1
        if W^.color = 'R' then
        begin
          W^.color     := 'B';
          Z^.up^.color := 'R';
          rot_l(Z^.up);
          W := Z^.up^.right;
        end;
        // Przypadek 2
        if(W^.left^.color = 'B') and
          (W^.right^.color = 'B') then
        begin
          W^.color := 'R';
          Z := Z^.up;
          continue;
        end;
        // Przypadek 3
        if W^.right^.color = 'B' then
        begin
          W^.left^.color := 'B';
          W^.color       := 'R';
          rot_r(W);
          W := Z^.up^.right;
        end;
        // Przypadek 4
        W^.color := Z^.up^.color;
        Z^.up^.color    := 'B';
        W^.right^.color := 'B';
        rot_l(Z^.up);
        // To spowoduje zakończenie pętli
        Z := root;
      end
      else
      // Przypadki lustrzane
      begin
        W := Z^.up^.left;
        // Przypadek 1
        if W^.color = 'R' then
        begin
          W^.color     := 'B';
          Z^.up^.color := 'R';
          rot_r(Z^.up);
          W := Z^.up^.left;
        end;
        if(W^.left^.color = 'B') and
          (W^.right^.color = 'B') then
        // Przypadek 2
        begin
          W^.color := 'R';
          Z := Z^.up;
          continue;
        end;
        if W^.left^.color = 'B' then
        // Przypadek 3
        begin
          W^.right^.color := 'B';
          W^.color        := 'R';
          rot_l(W);
          W := Z^.up^.left;
        end;
        // Przypadek 4
        W^.color := Z^.up^.color;
        Z^.up^.color   := 'B';
        W^.left^.color := 'B';
        rot_r(Z^.up);
        // To spowoduje zakończenie pętli
        Z := root;
      end;
  Z^.color := 'B';
  dispose(Y);
end;

//**********************
//*** PROGRAM GŁÓWNY ***
//**********************

var
  // Tablica kluczy węzłów
  Tk : array [0..MAXN-1] of integer;
  i, x, i1, i2 : integer;
  // Obiekt drzewa czerwono-czarnego
  RB : RBtree;

begin
  randomize;
  // Tworzymy puste drzewo
  RB.init;
  // Tablicę wypełniamy wartościami kluczy
  for i := 0 to MAXN-1 do
    Tk[i] := i+1;
  // Mieszamy tablicę
  for i := 1 to 300 do
  begin
    // Losujemy 2 indeksy
    i1 := random(MAXN);
    i2 := random(MAXN);
    // Wymieniamy Tk[i1] <--> Tk[i2]
    x := Tk[i1];
    Tk[i1] := Tk[i2];
    Tk[i2] := x;
  end;
  // Na podstawie tablicy tworzymy
  // drzewo czerwono-czarne
  for i := 0 to MAXN-1 do
  begin
    write(Tk[i], ' ');
    RB.insert_rbt(Tk[i]);
  end;
  writeln; writeln;
  // Wyświetlamy zawartość drzewa
  RB.print_rbt();
  writeln; writeln;
  // Ponownie mieszamy tablicę
  for i := 1 to 300 do
  begin
    i1 := random(MAXN);
    i2 := random(MAXN);
    x := Tk[i1];
    Tk[i1] := Tk[i2];
    Tk[i2] := x;
  end;
  // Usuwamy połowę węzłów
  for i := 0 to MAXN div 2 do
  begin
    write(Tk[i], ' ');
    RB.remove_rbt(RB.find_rbt(Tk[i]));
  end;
  writeln; writeln;
  // Wyświetlamy zawartość drzewa
  RB.print_rbt();
  // Usuwamy drzewo z pamięci
  RB.destroy;
end.

// Drzewo czerwono-czarne
// Data: 11.06.2013
// (C)2013 mgr Jerzy Wałaszek
//------------------------------

#include <iostream>
#include <string>
#include <cstdlib>
#include <ctime>

using namespace std;

// Liczba węzłów
const int MAXN = 30;

// Typ węzłów drzewa RBT
struct RBTnode
{
  RBTnode * up;
  RBTnode * left;
  RBTnode * right;
  int key;
  char color;
};

// Definicja typu obiektowego RBtree
class RBtree
{
  private:
    // Węzeł strażnika
    RBTnode S;
    // Korzeń drzewa czerwono-czarnego
    RBTnode * root;
    // Łańcuchy do znaków ramek
    string cr, cl, cp;

    // Wypisuje rekurencyjnie drzewo
    void t_print_rbt(string sp, 
                    string sn, 
                    RBTnode * p);
    // Usuwa rekurencyjnie drzewo
    void dfs_release(RBTnode * p);
    // Rotacja w lewo względem A
    void rot_l(RBTnode * A);
    // Rotacja w prawo względem A
    void rot_r(RBTnode * A);
    // Wyszukuje najmniejszy węzeł w p
    RBTnode * min_rbt(RBTnode * p);
    // Wyszukuje następnik p
    RBTnode * succ_rbt(RBTnode * p);

  public:
    // Konstruktor klasy
    RBtree();
    // Destruktor klasy
    ~RBtree();
    // Wypisuje drzewo
    void print_rbt();
    // Wyszukuje węzeł o kluczu k
    RBTnode * find_rbt(int k);
    // Wstawia węzeł o kluczu k
    void insert_rbt(int k);
    // Usuwa węzeł X
    void remove_rbt(RBTnode * X);
};

// Konstruktor drzewa
//-------------------
RBtree::RBtree()
{
  cr = cl = cp = "  ";
  cr[0] = 218; cr[1] = 196;
  cl[0] = 192; cl[1] = 196;
  cp[0] = 179;
  // Inicjujemy strażnika
  S.color = 'B';
  S.up    = &S;
  S.left  = &S;
  S.right = &S;
  // Korzeń wskazuje strażnika
  root = &S;
}

// Destruktor drzewa
//------------------
RBtree::~RBtree()
{
  // Rekurencyjnie usuwamy węzły
  dfs_release(root);
}

// Usuwa rekurencyjnie
// drzewo czerwono-czarne
//-----------------------
void RBtree::dfs_release(RBTnode * p)
{
  if(p != &S)
  {
    // usuwamy lewe poddrzewo
    dfs_release(p->left);
    // usuwamy prawe poddrzewo
    dfs_release(p->right);
    // usuwamy sam węzeł
    delete p;
  }
}

// Wypisuje zawartość drzewa
//--------------------------
void RBtree::t_print_rbt(string sp, 
                         string sn, 
                         RBTnode * p)
{
  string t;
  if(p != &S)
  {
    t = sp;
    if(sn == cr) t[t.length()-2] = ' ';
    t_print_rbt(t+cp, cr, p->right);

    t = t.substr(0, sp.length()-2);
    cout << t << sn
         << p->color << ":" << p->key
         << endl;
    t = sp;
    if(sn == cl) t[t.length()-2] = ' ';
    t_print_rbt(t+cp, cl, p->left);
  }
}

// Wypisuje zawartość drzewa
//--------------------------
void RBtree::print_rbt()
{
  t_print_rbt("", "", root);
}

// Wyszukuje węzeł o kluczu k
// Jeśli węzeł nie zostanie
// znaleziony, to zwraca
// wskazanie puste NULL
//---------------------------
RBTnode * RBtree::find_rbt(int k)
{
  RBTnode * p;

  p = root;
  while((p != &S) && (p->key != k))
    if(k < p->key) p = p->left;
    else           p = p->right;
  if(p == &S) return NULL;
  return p;
}

// Wyszukuje najmniejszy
// węzeł w poddrzewie
// o korzeniu p
//----------------------
RBTnode * RBtree::min_rbt(RBTnode * p)
{
  if(p != &S)
    while(p->left != &S) p = p->left;
  return p;
}

// Zwraca następnik p
//-------------------
RBTnode * RBtree::succ_rbt(RBTnode * p)
{
  RBTnode * r;

  if(p != &S)
  {
    if(p->right != &S)
      return min_rbt(p->right);
    else
    {
      r = p->up;
      while((r != &S) && (p == r->right))
      {
        p = r;
        r = r->up;
      }
      return r;
    }
  }
  return &S;
}

// Wykonuje rotację
// w lewo względem A
//------------------
void RBtree::rot_l(RBTnode * A)
{
  RBTnode * B, * p;

  B = A->right;
  if(B != &S)
  {
    p = A->up;
    A->right = B->left;
    if(A->right != &S)
      A->right->up = A;
    B->left = A;
    B->up   = p;
    A->up   = B;
    if(p != &S)
    {
      if(p->left == A)
        p->left = B;
      else
        p->right = B;
    }
    else root = B;
  }
}

// Wykonuje rotację
// w prawo względem A
//-------------------
void RBtree::rot_r(RBTnode * A)
{
  RBTnode * B, * p;

  B = A->left;
  if(B != &S)
  {
    p = A->up;
    A->left = B->right;
    if(A->left != &S)
      A->left->up = A;
    B->right = A;
    B->up    = p;
    A->up    = B;
    if(p != &S)
    {
      if(p->left == A)
        p->left = B;
      else
        p->right = B;
    }
    else root = B;
  }
}

// Wstawia do drzewa
// węzeł o kluczu k
//------------------
void RBtree::insert_rbt(int k)
{
  RBTnode * X, * Y;

  // Tworzymy nowy węzeł
  X = new RBTnode;
  // Inicjujemy pola
  X->left  = &S;
  X->right = &S;
  X->up    = root;
  X->key   = k;
  // X staje się korzeniem
  if(X->up == &S)
    root = X;
  else
    // Szukamy liścia
    // do zastąpienia przez X
    while(true)
    {
      if(k < X->up->key)
      {
        if(X->up->left == &S)
        {
          // X zastępuje lewy liść
          X->up->left = X;
          break;
        }
        X->up = X->up->left;
      }
      else
      {
        if(X->up->right == &S)
        {
          // X zastępuje prawy liść
          X->up->right = X;
          break;
        }
        X->up = X->up->right;
      }
    }
  // Węzeł kolorujemy na czerwono
  X->color = 'R';
  while((X != root) && (X->up->color == 'R'))
  {
    if(X->up == X->up->up->left)
    {
      // Y -> wujek X
      Y = X->up->up->right;
      // Przypadek 1
      if(Y->color == 'R')
      {
        X->up->color = 'B';
        Y->color = 'B';
        X->up->up->color = 'R';
        X = X->up->up;
        continue;
      }
      // Przypadek 2
      if(X == X->up->right)
      {
        X = X->up;
        rot_l(X);
      }
      // Przypadek 3
      X->up->color = 'B';
      X->up->up->color = 'R';
      rot_R (X->up->up);
      break;
    }
    else
    // Przypadki lustrzane
    {
      Y = X->up->up->left;
      // Przypadek 1
      if(Y->color == 'R')
      {
        X->up->color = 'B';
        Y->color = 'B';
        X->up->up->color = 'R';
        X = X->up->up;
        continue;
      }
      // Przypadek 2
      if(X == X->up->left)
      {
        X = X->up;
        rot_R (X);
      }
      // Przypadek 3
      X->up->color = 'B';
      X->up->up->color = 'R';
      rot_L (X->up->up);
      break;
    }
  }
  root->color = 'B';
}

// Usuwa z drzewa węzeł X
//-----------------------
void RBtree::remove_rbt(RBTnode * X)
{
  RBTnode * W, * Y, * Z;

  if((X->left == &S) || (X->right == &S))
    Y = X;
  else
    Y = succ_rbt(X);
  if(Y->left != &S)
    Z = Y->left;
  else
    Z = Y->right;
  Z->up = Y->up;
  if(Y->up == &S)
    root = Z;
  else
    if(Y == Y->up->left)
      Y->up->left  = Z;
    else
      Y->up->right = Z;
  if(Y != X)
    X->key = Y->key;
  // Naprawa struktury
  // drzewa czerwono-czarnego
  if(Y->color == 'B')
  {
    while((Z != root) && (Z->color == 'B'))
      if(Z == Z->up->left)
      {
        W = Z->up->right;
        if(W->color == 'R')
        {
          // Przypadek 1
          W->color = 'B';
          Z->up->color = 'R';
          rot_L (Z->up);
          W = Z->up->right;
        }
        if((W->left->color == 'B') &&
           (W->right->color == 'B'))
        {
          // Przypadek 2
          W->color = 'R';
          Z = Z->up;
          continue;
        }
        if(W->right->color == 'B')
        {
          // Przypadek 3
          W->left->color = 'B';
          W->color = 'R';
          rot_R (W);
          W = Z->up->right;
        }
        // Przypadek 4
        W->color = Z->up->color;
        Z->up->color = 'B';
        W->right->color = 'B';
        rot_L (Z->up);
        // To spowoduje zakończenie pętli
        Z = root;
      }
      else
      {
        // Przypadki lustrzane
        W = Z->up->left;
        if(W->color == 'R')
        {
          // Przypadek 1
          W->color = 'B';
          Z->up->color = 'R';
          rot_R (Z->up);
          W = Z->up->left;
        }

        if((W->left->color == 'B') &&
           (W->right->color == 'B'))
        {
          // Przypadek 2
          W->color = 'R';
          Z = Z->up;
          continue;
        }
        if(W->left->color == 'B')
        {
          // Przypadek 3
          W->right->color = 'B';
          W->color = 'R';
          rot_L (W);
          W = Z->up->left;
        }
        // Przypadek 4
        W->color = Z->up->color;
        Z->up->color = 'B';
        W->left->color = 'B';
        rot_R (Z->up);
        // To spowoduje zakończenie pętli
        Z = root;
      }
  }
  Z->color = 'B';
  delete Y;
}

//**********************
//*** PROGRAM GŁÓWNY ***
//**********************

int main()
{
  // Tablica kluczy węzłów
  int Tk[MAXN];
  int i, i1, i2;
  // Obiekt drzewa czerwono-czarnego
  RBtree * RB;

  srand (time(NULL));
  // Tworzymy puste drzewo
  RB = new RBtree;
  // Tablicę wypełniamy
  // wartościami kluczy
  for(i = 0; i < MAXN; i++)
    Tk[i] = i+1;
  // Mieszamy tablicę
  for(i = 0; i < 300; i++)
  {
    // Losujemy 2 indeksy
    i1 = rand()%MAXN;
    i2 = rand()%MAXN;
    // Wymieniamy Tk[i1] <--> Tk[i2]
    swap(Tk[i1], Tk[i2]);
  }
  // Na podstawie tablicy
  // tworzymy drzewo czerwono-czarne
  for(i = 0; i < MAXN; i++)
  {
    cout << Tk[i] << " ";
    RB->insert_rbt(Tk[i]);
  }
  cout << endl << endl;
  // Wyświetlamy zawartość drzewa
  RB->print_rbt();
  cout << endl << endl;
  // Ponownie mieszamy tablicę
  for(i = 0; i < 300; i++)
  {
    i1 = rand()%MAXN;
    i2 = rand()%MAXN;
    swap(Tk[i1], Tk[i1]);
  }
  // Usuwamy połowę węzłów
  for(i = 0; i < MAXN >> 1; i++)
  {
    cout << Tk[i] << " ";
    RB->remove_rbt(RB->find_rbt(Tk[i]));
  }
  cout << endl << endl;
  // Wyświetlamy zawartość drzewa
  RB->print_rbt();
  // Usuwamy drzewo z pamięci
  delete RB;
  return 0;}

' Drzewo czerwono-czarne
' Data: 11.06.2013
' (C)2013 mgr Jerzy Wałaszek
'---------------------------

' Liczba węzłów
const MAXN = 30

' Typ węzłów drzewa RBT
Type RBTnode
  up    As RBTnode Ptr
  left  As RBTnode Ptr
  right As RBTnode Ptr
  key   As Integer
  color As String * 1
End Type

' Definicja typu obiektowego RBtree
Type RBtree
  Private:
    ' Węzeł strażnika
    S As RBTnode
    ' Korzeń drzewa czerwono-czarnego
    root As RBTnode Ptr
    ' Łańcuchy do znaków ramek
    cr As String * 2
    cl As String * 2
    cp As String * 2

    ' Usuwa rekurencyjnie drzewo
    Declare Sub dfs_release(p As RBTnode Ptr)
    ' Wypisuje drzewo
    Declare Sub t_print_rbt(sp As String, _
                           sn As String, _
                            p As RBTnode Ptr)
    ' Rotacja w lewo względem A
    Declare Sub rot_l(A As RBTnode Ptr)
    ' Rotacja w prawo względem A
    Declare Sub rot_r(A As RBTnode Ptr)
    ' Wyszukuje najmniejszy węzeł w p
    Declare Function min_rbt(p As RBTnode Ptr) _
                              As RBTnode Ptr
    ' Wyszukuje następnik p
    Declare Function succ_rbt (p As RBTnode Ptr) _
                                As RBTnode Ptr
  Public:
    ' Konstruktor klasy
    Declare Constructor()
    ' Destruktor klasy
    Declare Destructor()
    ' Wypisuje drzewo
    Declare Sub print_rbt
    ' Wyszukuje węzeł o kluczu k
    Declare Function find_rbt(k As Integer) _
                               As RBTnode Ptr
    ' Wstawia węzeł o kluczu k
    Declare Sub insert_rbt(k As Integer)
    ' Usuwa węzeł X
    Declare Sub remove_rbt(X As RBTnode Ptr)
End Type

' Konstruktor drzewa
'-------------------
Constructor RBtree()
  cr = Chr(218)+Chr (196)
  cl = Chr(192)+Chr (196)
  cp = Chr(179)+" "
  ' Inicjujemy strażnika
  S.color = "B"
  S.up    = @S
  S.left  = @S
  S.right = @S
  ' Korzeń wskazuje strażnika
  root    = @S
End Constructor

' Destruktor drzewa
'------------------
Destructor RBtree
  ' Rekurencyjnie usuwamy węzły
  dfs_release root
End Destructor

' Usuwa rekurencyjnie
' drzewo czerwono-czarne
'-----------------------
Sub RBtree.dfs_release(p As RBTnode Ptr)
  If p <> @S Then
    ' usuwamy lewe poddrzewo
    dfs_release p->left
    ' usuwamy prawe poddrzewo
    dfs_release p->right
    ' usuwamy sam węzeł
    Delete p
  End If
End Sub

' Wypisuje zawartość drzewa
'--------------------------
Sub RBtree.t_print_rbt(sp As String, _
                       sn As String, _
                       p As RBTnode Ptr)
  Dim As String t

  If p <> @S Then
    t = sp
    If sn = cr Then _
      Mid(t, Len(t)-1, 1) = " "
    t_print_rbt t+cp, cr, p->right
    t = Mid(t, 1, Len(sp)-2)
    Print Using "&&&:&";t;sn;p->Color;p->key
    t = sp
    If sn = cl Then _
      Mid(t, Len(t)-1, 1) = " "
    t_print_rbt t+cp, cl, p->left
  End If
End Sub

' Wypisuje zawartość drzewa
'--------------------------
Sub RBtree.print_rbt
  t_print_rbt "", "", root
End Sub

' Wyszukuje węzeł o kluczu k
' Jeśli węzeł nie zostanie
' znaleziony, to zwraca
' wskazanie puste NULL
'---------------------------
Function RBtree.find_rbt(k As Integer) _
                           As RBTnode Ptr
  Dim As RBTnode Ptr p

  p = root
  while p <> @S AndAlso p->key <> k
    If k < p->key Then
    	p = p->Left
    Else
      p = p->Right
    End If
  Wend
  If p = @S Then return 0
  Return p
End Function

' Wyszukuje najmniejszy
' węzeł w poddrzewie
' o korzeniu p
'----------------------
Function RBtree.min_rbt(p As RBTnode Ptr) _
                          As RBTnode Ptr
  If p <> @S Then _
    While p->left <> @S: p = p->Left: Wend
  Return p
End Function

' Zwraca następnik p
'-------------------
Function RBtree.succ_rbt(p As RBTnode Ptr) _
                           As RBTnode Ptr
  Dim As RBTnode Ptr r

  If p <> @S Then
    If p->right <> @S Then
      Return min_rbt(p->right)
    Else
      r = p->up
      while r <> @S AndAlso p = r->right
        p = r
        r = r->up
      Wend
      Return r
    End If
  End If
  Return @S
End Function

' Wykonuje rotację w lewo względem A
'-----------------------------------
Sub RBtree.rot_l(A As RBTnode Ptr)

  Dim As RBTnode Ptr B, p

  B = A->Right
  If B <> @S Then
    p = A->up
    A->right = B->Left
    If A->right <> @S Then _
      A->right->up = A
    B->left = A
    B->up   = p
    A->up   = B
    If p <> @S Then
      If p->left = A then
        p->left = B
      Else
        p->right = B
      End If
    Else
      root = B
    End If   
  End If
End Sub

' Wykonuje rotację w prawo względem A
'------------------------------------
Sub RBtree.rot_r(A As RBTnode Ptr)

  Dim As RBTnode Ptr B, p

  B = A->Left
  if B <> @S Then
    p = A->up
    A->left = B->Right
    if A->left <> @S Then _
      A->left->up = A
    B->right = A
    B->up    = p
    A->up    = B
    If p <> @S Then
      If p->left = A then
        p->left = B
      Else
        p->right = B
      End If
    Else
      root = B
    End If
  End If
End Sub

' Wstawia do drzewa węzeł o kluczu k
'-----------------------------------
Sub RBtree.insert_rbt(k As Integer)

  Dim As RBTnode Ptr X, Y

  ' Tworzymy nowy węzeł
  X = new RBTnode
  ' Inicjujemy pola
  X->left  = @S
  X->right = @S
  X->up    = root
  X->key   = k
  If X->up = @S Then
    ' X staje się korzeniem
    root = X
  Else
    ' Szukamy liścia
    ' do zastąpienia przez X
    Do
       If k < X->up->key Then
        If X->up->left = @S Then
          ' X zastępuje lewy liść
          X->up->left = X
          Exit Do
        End If
        X->up = X->up->Left
      Else
        If X->up->right = @S Then
          ' X zastępuje prawy liść
          X->up->right = X
          Exit Do
        End If
        X->up = X->up->Right
      End If
    Loop
  End If
  ' Węzeł kolorujemy na czerwono
  X->color = "R"
   while X <> root AndAlso X->up->color = "R"
    If X->up = X->up->up->Left Then
      ' Y -> wujek X
      Y = X->up->up->Right
      If Y->color = "R" Then
        ' Przypadek 1
        X->up->color     = "B"
        Y->color         = "B"
        X->up->up->color = "R"
        X = X->up->up
        Continue While
      End If
      If X = X->up->Right Then
        ' Przypadek 2
        X = X->up
        rot_L X
      End If
      ' Przypadek 3
      X->up->color     = "B"
      X->up->up->color = "R"
      rot_R X->up->up
      Exit While
    Else
      ' Przypadki lustrzane    
      Y = X->up->up->Left
      if Y->color = "R" Then
        ' Przypadek 1
        X->up->color     = "B"
        Y->color         = "B"
        X->up->up->color = "R"
        X = X->up->up
        Continue While
      End If
      if X = X->up->Left Then
        ' Przypadek 2
        X = X->up
        rot_R X
      End If
      ' Przypadek 3
      X->up->color     = "B"
      X->up->up->color = "R"
      rot_L X->up->up
      Exit While
    End If
  Wend
  root->color = "B"
End Sub

' Usuwa z drzewa węzeł X
'-----------------------
Sub RBtree.remove_rbt(X As RBTnode Ptr)

  Dim As RBTnode Ptr W, Y, Z

  If X->left = @S OrElse _
    X->right = @S Then
    Y = X
  Else
    Y = succ_rbt(X)
  End If
  if Y->left <> @S Then
    Z = Y->Left
  Else
    Z = Y->Right
  End If
  Z->up = Y->up
  If Y->up = @S Then
    root = Z
  ElseIf Y = Y->up->Left Then
    Y->up->Left = Z
  Else
    Y->up->right = Z
  End If
  If Y <> X Then X->key = Y->key
  If Y->color = "B" Then
    ' Naprawa struktury
    ' drzewa czerwono-czarnego
    While Z <> root AndAlso _
          Z->color = "B"
      If Z = Z->up->Left Then
        W = Z->up->Right
        If W->color = "R" Then
          ' Przypadek 1
          W->color     = "B"
          Z->up->color = "R"
          rot_L Z->up
          W = Z->up->Right
        End If
        If W->left->color = "B" AndAlso _
           W->right->color = "B" Then
          ' Przypadek 2
          W->color = "R"
          Z = Z->up
          Continue While
        End If
        if W->right->color = "B" Then
          ' Przypadek 3
          W->left->color = "B"
          W->color       = "R"
          rot_R W
          W = Z->up->Right
        End If
        ' Przypadek 4
        W->color = Z->up->Color
        Z->up->color    = "B"
        W->right->color = "B"
        rot_L Z->up
        ' To spowoduje zakończenie pętli
        Z = root
      Else
        ' Przypadki lustrzane
        W = Z->up->Left
        If W->color = "R" Then
          ' Przypadek 1
          W->color     = "B"
          Z->up->color = "R"
          rot_R Z->up
          W = Z->up->Left
        End If
        If W->left->color = "B" AndAlso _
           W->right->color = "B" Then
          ' Przypadek 2
          W->color = "R"
          Z = Z->up
          Continue While
        End If
        If W->left->color = "B" Then
          ' Przypadek 3
          W->right->color = "B"
          W->color        = "R"
          rot_L W
          W = Z->up->Left
        End If
        ' Przypadek 4
        W->color = Z->up->Color
        Z->up->color   = "B"
        W->left->color = "B"
        rot_R Z->up
        ' To spowoduje zakończenie pętli
        Z = root
      End If
    Wend
  End If
  Z->color = "B"
  Delete Y
End Sub

'**********************
'*** PROGRAM GŁÓWNY ***
'**********************

' Tablica kluczy węzłów
Dim As Integer Tk(MAXN-1)
Dim As Integer i, i1, i2
' Obiekt drzewa czerwono-czarnego
Dim As RBtree Ptr RB

Randomize
' Tworzymy puste drzewo
RB = new RBtree
' Tablicę wypełniamy wartościami kluczy
For i = 0 To MAXN-1
  Tk(i) = i+1
Next
' Mieszamy tablicę
For i = 0 To 300
  ' Losujemy 2 indeksy
  i1 = Int(Rnd()*MAXN)
  i2 = Int(Rnd()*MAXN)
  ' Wymieniamy Tk(i1) <--> Tk(i2)
  Swap Tk(i1), Tk(i2)
Next
' Na podstawie tablicy tworzymy
' drzewo czerwono-czarne
For i = 0 To MAXN-1
  Print Tk(i);
  RB->insert_rbt Tk(i)
Next
Print: Print
' Wyświetlamy zawartość drzewa
RB->print_rbt
Print: Print
' Ponownie mieszamy tablicę
For i = 0 To 300
  i1 = Int(Rnd()*MAXN)
  i2 = Int(Rnd()*MAXN)
  Swap Tk(i1), Tk(i2)
Next
' Usuwamy połowę węzłów
For i = 0 To MAXN\2          
  Print Tk(i);
  RB->remove_rbt RB->find_rbt(Tk(i))
Next
Print: Print
' Wyświetlamy zawartość drzewa
RB->print_rbt
' Usuwamy drzewo z pamięci
Delete RB
End