type
  PRBTNode = ^RBTNode;
  RBTNode =  record
    up    : PRBTNode;
    left  : PRBTNode;
    right : PRBTNode;
    key   : typ_danych;
    ...
  end;

struct RBTNode
{
  RBTNode *up, *left, *right;
  typ_danych key;
  ...
};

Type RBTNode
  up As RBTNode Ptr
  left As RBTNode Ptr
  right As RBTNode Ptr
  key As typ_danych
  ...
End Type

// Zbiory zaimplementowane w drzewach czerwono-czarnych
// Data   : 9.07.2014
// (C)2014 mgr Jerzy Wałaszek
//-----------------------------------------------------

program sets;

// Definicja węzła drzewa czerwono-czarnego

type
  PRBTNode = ^RBTNode;
  RBTNode  = record
    up    : PRBTNode;
    left  : PRBTNode;
    right : PRBTNode;
    key   : integer;
    color : char;
  end;

// Zmienne globalne

var
  S : RBTNode = ( up:@S;left:@S;right:@S;key:0;color:'B' ); // Węzeł strażnika

// Procedury obsługi drzew czerwono-czarnych

// Wykonuje rotację w lewo względem A
//-----------------------------------
procedure rot_L ( var root : PRBTNode; 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 rot_R ( var root : PRBTNode; 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 insertRBT ( var root : PRBTNode; k : integer );
var
  X, Y : PRBTNode;
begin
  new ( X );               // Tworzymy nowy węzeł
  X^.left  := @S;          // Inicjujemy pola
  X^.right := @S;
  X^.up    := root;
  X^.key   := k;
  if X^.up = @S then root := X // X staje się korzeniem
  else
  while true do            // Szukamy liścia do zastąpienia przez X
  begin
    if k < X^.up^.key then
    begin
      if X^.up^.left = @S then
      begin
        X^.up^.left := X;  // X zastępuje lewy liść
        break;
      end;
      X^.up := X^.up^.left;
    end
    else
    begin
      if X^.up^.right = @S then
      begin
        X^.up^.right := X; // X zastępuje prawy liść
        break;
      end;
      X^.up := X^.up^.right;
    end;
  end;
  X^.color := 'R';         // Węzeł kolorujemy na czerwono
  while( X <> root ) and ( X^.up^.color = 'R' ) do
  begin
    if X^.up = X^.up^.up^.left then
    begin
      Y := X^.up^.up^.right; // Y -> wujek X

      if Y^.color = 'R' then // Przypadek 1
      begin
        X^.up^.color := 'B';
        Y^.color := 'B';
        X^.up^.up^.color := 'R';
        X := X^.up^.up;
        continue;
      end;

      if X = X^.up^.right then // Przypadek 2
      begin
        X := X^.up;
        rot_L ( root, X );
      end;

      X^.up^.color := 'B'; // Przypadek 3
      X^.up^.up^.color := 'R';
      rot_R ( root, X^.up^.up );
      break;
    end
    else
    begin                  // Przypadki lustrzane
      Y := X^.up^.up^.left;

      if Y^.color = 'R' then // Przypadek 1
      begin
        X^.up^.color := 'B';
        Y^.color := 'B';
        X^.up^.up^.color := 'R';
        X := X^.up^.up;
        continue;
      end;

      if X = X^.up^.left then // Przypadek 2
      begin
        X := X^.up;
        rot_R ( root, X );
      end;

      X^.up^.color := 'B'; // Przypadek 3
      X^.up^.up^.color := 'R';
      rot_L ( root, X^.up^.up );
      break;
    end;
  end;
  root^.color := 'B';
end;

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

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

// Usuwa z drzewa węzeł X
//-----------------------
procedure removeRBT ( var root : PRBTNode; X : PRBTNode );
var
  W, Y, Z : PRBTNode;
begin
  if( X^.left = @S ) or ( X^.right = @S ) then Y := X
  else Y := succRBT ( 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;

  if Y^.color = 'B' then   // Naprawa struktury drzewa czerwono-czarnego
    while( Z <> root ) and ( Z^.color = 'B' ) do
      if Z = Z^.up^.left then
      begin

        W := Z^.up^.right;

        if W^.color = 'R' then
        begin              // Przypadek 1
          W^.color := 'B';
          Z^.up^.color := 'R';
          rot_L ( root, Z^.up );
          W := Z^.up^.right;
        end;

        if( W^.left^.color = 'B' ) and ( W^.right^.color = 'B' ) then
        begin              // Przypadek 2
          W^.color := 'R';
          Z := Z^.up;
          continue;
        end;

        if W^.right^.color = 'B' then
        begin              // Przypadek 3
          W^.left^.color := 'B';
          W^.color := 'R';
          rot_R ( root, W );
          W := Z^.up^.right;
        end;

        W^.color := Z^.up^.color; // Przypadek 4
        Z^.up^.color := 'B';
        W^.right^.color := 'B';
        rot_L ( root, Z^.up );
        Z := root;         // To spowoduje zakończenie pętli
      end
      else
      begin                // Przypadki lustrzane
        W := Z^.up^.left;

        if W^.color = 'R' then
        begin              // Przypadek 1
          W^.color := 'B';
          Z^.up^.color := 'R';
          rot_R ( root, Z^.up );
          W := Z^.up^.left;
        end;

        if( W^.left^.color = 'B' ) and ( W^.right^.color = 'B' ) then
        begin              // Przypadek 2
          W^.color := 'R';
          Z := Z^.up;
          continue;
        end;

        if W^.left^.color = 'B' then
        begin              // Przypadek 3
          W^.right^.color := 'B';
          W^.color := 'R';
          rot_L ( root, W );
          W := Z^.up^.left;
        end;

        W^.color := Z^.up^.color;  // Przypadek 4
        Z^.up^.color := 'B';
        W^.left^.color := 'B';
        rot_R ( root, Z^.up );
        Z := root;         // To spowoduje zakończenie pętli
      end;

  Z^.color := 'B';
  dispose ( Y );
end;

// Procedury obsługi zbioru

// Szuka w drzewie węzła o danej wartości klucza x. Jeśli węzeł zostanie
// znaleziony, to zwraca jego adres. Inaczej zwraca wskazanie puste.
//----------------------------------------------------------------------
function s_isin ( A:PRBTNode; x : integer ) : PRBTNode;
begin
  while A <> @S do
  begin
    if A^.key = x then Exit ( A ); // Węzeł znaleziony
    if x < A^.key then A := A^.left
    else A := A^.right;
  end;
  s_isin := nil;           // Węzeł nieznaleziony
end;

// Dodaje do drzewa nowy węzeł, jesli w drzewie takiego węzła jeszcze nie ma
//--------------------------------------------------------------------------
procedure s_add ( var A : PRBTNode; x : integer );
begin
  if s_isin ( A, x ) = nil then insertRBT ( A, x );
end;

// Wyszukuje w drzewie węzeł o kluczu x i usuwa go
//------------------------------------------------
procedure s_remove ( var A : PRBTNode; x : integer );
var
  p : PRBTNode;
begin
  p := s_isin ( A, x );    // Szukamy węzła o kluczu x
  if p <> nil then removeRBT ( A, p );
end;

// Usuwa wszystkie węzły z drzewa
//-------------------------------
procedure s_clear ( var A : PRBTNode );
begin
  if A <> @S then
  begin
    s_clear ( A^.left );   // Rekurencyjnie usuwamy lewe poddrzewo
    s_clear ( A^.right );  // Rekurencyjnie usuwamy prawe poddrzewo
    dispose ( A );         // Usuwamy węzeł
    A := @S;
  end;
end;

// Procedura kopiuje elementy z drzewa A do C
//-------------------------------------------
procedure s_copy ( A : PRBTNode; var C : PRBTNode );
begin
  if A <> @S then
  begin
    s_add ( C, A^.key );   // Dodajemy do C klucz bieżącego węzła
    s_copy ( A^.left, C ); // Rekurencyjnie dodajemy do C lewe poddrzewo
    s_copy ( A^.right, C );// Rekurencyjnie dodajemy do C prawe poddrzewo
  end;
end;

// Procedura tworzy sumę zbiorów A i B w C
//----------------------------------------
procedure s_union ( A, B : PRBTNode; var C : PRBTNode );
begin
  s_clear ( c );           // Czyścimy C
  s_copy ( A, C );         // W C umieszczamy A
  s_copy ( B, C );         // Dodajemy B do C
end;

// Procedura kopiuje do C te elementy A, które również są w B
//-----------------------------------------------------------
procedure s_icopy ( A, B : PRBTNode; var C : PRBTNode );
begin
  if A <> @S then
  begin
    if s_isin ( B, A^.key ) <> nil then s_add ( C, A^.key );
    s_icopy ( A^.left, B, C );
    s_icopy ( A^.right, B, C );
  end;
end;

// Procedura tworzy w C iloczyn zbiorów A i B
//-------------------------------------------
procedure s_intersection ( A, B : PRBTNode; var C : PRBTNode );
begin
  s_clear ( c );           // Czyścimy C
  s_icopy ( A, B, C );     // Tworzymy iloczyn zbiorów
end;

// Procedura kopiuje do C te elementy A, których nie ma w B
//---------------------------------------------------------
procedure s_dcopy ( A, B : PRBTNode; var C : PRBTNode );
begin
  if A <> @S then
  begin
    if s_isin ( B, A^.key ) = nil then s_add ( C, A^.key );
    s_dcopy ( A^.left, B, C );
    s_dcopy ( A^.right, B, C );
  end;
end;

// Procedura tworzy w C różnicę zbiorów A i B
//-------------------------------------------
procedure s_difference ( A, B : PRBTNode; var C : PRBTNode );
begin
  s_clear ( c );           // Czyścimy C
  s_dcopy ( A, B, C );     // Tworzymy różnicę zbiorów
end;

// Funkcja zwraca true, jeśli zbiór A jest podzbiorem B
//-----------------------------------------------------
function s_subset ( A, B : PRBTNode ) : boolean;
begin
  if A = @S then Exit ( true );
  if s_isin ( B, A^.key ) = nil then Exit ( false );
  s_subset := s_subset ( A^.left, B ) and s_subset ( A^.right, B );
end;

// Procedura zlicza rekurencyjnie węzły w drzewie
//-----------------------------------------------
procedure s_cnt ( A : PRBTNode; var cnt : integer );
begin
  if A <> @S then
  begin
    inc ( cnt );            // Zliczamy węzeł bieżący
    s_cnt ( A^.left, cnt ); // Rekurencyjnie liczymy węzły w lewym poddrzewie
    s_cnt ( A^.right, cnt );// Rekurencyjnie liczymy węzły w prawym poddrzewie
  end;
end;

// Funkcja oblicza liczbę węzłów w drzewie
//----------------------------------------
function s_size ( A : PRBTNode ) : integer;
var
  cnt : integer;          // Licznik węzłów
begin
  cnt := 0;               // Zerujemy licznik
  s_cnt ( A, cnt );       // Zliczamy węzły
  s_size := cnt;          // Zwracamy wynik
end;

// Funkcja zwraca true, jeśli zbiór jest pusty
//--------------------------------------------
function s_empty ( A : PRBTNode ) : boolean;
begin
  s_empty := A = @S;
end;

// Procedura rekurencyjnie wyświetla zawartość drzewa
//---------------------------------------------------
procedure s_print ( A : PRBTNode );
begin
  if A <> @S then
  begin
    s_print ( A^.left );
    write ( A^.key, ' ' );
    s_print ( A^.right );
  end;
end;

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

var
  A, B, C, D : PRBTNode;
  i, x     : integer;

begin
  randomize;              // Inicjujemy generator pseudolosowy

  // Tworzymy puste zbiory

  A := @S;
  B := @S;
  C := @S;
  D := @S;

  // Do zbioru A dodajemy 10 losowych elementów

  for i := 1 to 10 do s_add ( A, -20 + random ( 41 ) );

  // Do zbioru B dodajemy 15 losowych elementów

  for i := 1 to 15 do s_add ( B, -20 + random ( 41 ) );

  // Wyświetlamy je

  writeln ( 'A:' );
  s_print ( A ); writeln;
  writeln ( 'SIZE OF A IS ', s_size ( A ) );
  writeln;
  writeln ( 'B:' );
  s_print ( B ); writeln;
  writeln ( 'SIZE OF B IS ', s_size ( B ) );

  // Suma zbiorów

  writeln;
  writeln ( 'UNION OF A AND B:' );
  s_union ( A, B, C );
  s_print ( c ); writeln;
  writeln ( 'SIZE OF UNION IS ', s_size ( c ) );

  // Iloczyn zbiorów

  writeln;
  writeln ( 'INTERSECTION OF A AND B:' );
  s_intersection ( A, B, C );
  s_print ( c ); writeln;
  writeln ( 'SIZE OF INTERSECTION IS ', s_size ( c ) );

  // Różnica zbiorów

  writeln;
  writeln ( 'DIFFERENCE OF A AND B:' );
  s_difference ( A, B, C );
  s_print ( c ); writeln;
  writeln ( 'SIZE OF DIFFERENCE IS ', s_size ( c ) );

  // Podzbiór

  s_union ( A, A, C );            // Kopiujemy A do C
  for i := 1 to 7 do              // Usuwamy 7 elementów
    s_remove ( C, -20 + random ( 41 ) );
  writeln;
  writeln ( 'IS:' );
  s_print ( c );
  writeln ( ' SUBSET OF A?' );
  writeln ( s_subset ( C, A ) );

  s_difference ( B, A, C );
  for i := 1 to 12 do              // Usuwamy 12 elementów
    s_remove ( C, -20 + random ( 41 ) );
  writeln;
  writeln ( 'IS:' );
  s_print ( c );
  writeln ( ' SUBSET OF A?' );
  writeln ( s_subset ( C, A ) );

  // Usuwanie

  writeln;
  write ( 'FROM A WE REMOVE' );
  for i := 1 to 5 do
  begin
    x := -20 + random ( 41 );
    write ( x:4 );
    s_remove ( A, x );
  end;
  writeln;
  writeln ( 'A:' ); s_print ( A ); writeln;
  writeln ( 'SIZE OF A IS ', s_size ( A ) );
  writeln;

  // Sprawdzamy obecność wybranych elementów w B

  for i := 1 to 10 do
  begin
    x := -20 + random ( 41 );
    write ( 'IS ELEMENT', x:4, ' IN SET B? ' );
    if s_isin ( B, x ) <> nil then writeln ( 'YES' ) else writeln ( 'NO' );
  end;
  writeln;

  // Sprawdzenie testu na zbiór pusty

  writeln ( 'IS SET A EMPTY?' );
  writeln ( s_empty ( A ) );
  writeln;

  writeln ( 'IS INTERSECTION OF A AND DIFFERENCE OF B AND A EMPTY?' );
  s_difference ( B, A, C );
  s_intersection ( A, C, D );
  writeln ( s_empty ( D ) );
  writeln;

  // Usuwamy zbiory

  s_clear ( A );
  s_clear ( B );
  s_clear ( c );
  s_clear ( D );

end.

' Zbiory zaimplementowane w drzewach czerwono-czarnych
' Data   : 9.07.2014
' (C)2014 mgr Jerzy Wałaszek
'-----------------------------------------------------

' Definicja węzła drzewa czerwono-czarnego

Type RBTNode
  up    As RBTNode Ptr
  left  As RBTNode Ptr
  right As RBTNode Ptr
  key   As Integer
  color As String * 1
End Type

' Zmienne globalne

Dim Shared As RBTNode S => ( @S, @S, @S, 0, "B" )

' Procedury obsługi drzew czerwono-czarnych

' Wykonuje rotację w lewo względem A
'-----------------------------------
Sub rot_L ( ByRef root As RBTNode Ptr, ByVal 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
    Else
      root = B
    End If
    
  End If
End Sub

' Wykonuje rotację w prawo względem A
'------------------------------------
Sub rot_R ( ByRef root As RBTNode Ptr, ByVal 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
    Else
      root = B
    End If
  End If
End Sub

' Wstawia do drzewa węzeł o kluczu k
'-----------------------------------
Sub insertRBT ( ByRef root As RBTNode Ptr, ByVal k As Integer )

  Dim As RBTNode Ptr X, Y

  X = new RBTNode  ' Tworzymy nowy węzeł
  X->left  = @S    ' Inicjujemy pola
  X->right = @S
  X->up    = root
  X->key   = k
  If X->up = @S Then
  	  root = X ' X staje się korzeniem
  Else
    Do             ' Szukamy liścia do zastąpienia przez X
  
      If k < X->up->key Then
        If X->up->left = @S Then
          X->up->left = X  ' X zastępuje lewy liść
          Exit Do
        End If
        X->up = X->up->Left
      Else
        If X->up->right = @S Then
          X->up->right = X ' X zastępuje prawy liść
          Exit Do
        End If
        X->up = X->up->Right
      End If
      
    Loop
  End If
  
  X->color = "R"         ' Węzeł kolorujemy na czerwono
  
  while( X <> root ) AndAlso ( X->up->color = "R" )
    If X->up = X->up->up->Left Then

      Y = X->up->up->Right ' Y -> wujek X

      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 ( root, X )
      End If

      X->up->color = "B" ' Przypadek 3
      X->up->up->color = "R"
      rot_R ( root, 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 ( root, X )
      End If

      X->up->color = "B" ' Przypadek 3
      X->up->up->color = "R"
      rot_L ( root, X->up->up )
      Exit While
    End If
  Wend
  root->color = "B"
End Sub

' Wyszukuje najmniejszy węzeł w poddrzewie
' o korzeniu p
'-----------------------------------------
Function minRBT ( ByVal 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 succRBT ( ByVal p As RBTNode Ptr ) As RBTNode Ptr

  Dim As RBTNode Ptr r

  If p <> @S Then
    If p->right <> @S Then
      Return minRBT ( 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

' Usuwa z drzewa węzeł X
'-----------------------
Sub removeRBT ( ByRef root As RBTNode Ptr, ByVal X As RBTNode Ptr  )

  Dim As RBTNode Ptr W, Y, Z

  if( X->left = @S ) OrElse ( X->right = @S ) Then
  	 Y = X
  Else
    Y = succRBT ( 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 ( root, 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 ( root, W )
          W = Z->up->Right
        End If

        W->color = Z->up->Color ' Przypadek 4
        Z->up->color = "B"
        W->right->color = "B"
        rot_L ( root, Z->up )
        Z = root         ' To spowoduje zakończenie pętli
      Else               ' Przypadki lustrzane
        
        W = Z->up->Left

        If W->color = "R" Then ' Przypadek 1
          W->color = "B"
          Z->up->color = "R"
          rot_R ( root, 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 ( root, W )
          W = Z->up->Left
        End If

        W->color = Z->up->Color  ' Przypadek 4
        Z->up->color = "B"
        W->left->color = "B"
        rot_R ( root, Z->up )
        Z = root         ' To spowoduje zakończenie pętli
      End If
    Wend
  End If
  Z->color = "B"

  Delete Y
  
End Sub

' Procedury obsługi zbioru

' Szuka w drzewie węzła o danej wartości klucza x. Jeśli węzeł zostanie
' znaleziony, to zwraca jego adres. Inaczej zwraca wskazanie puste.
'----------------------------------------------------------------------
Function s_isin ( ByVal A As RBTNode Ptr, ByVal x As Integer ) As RBTNode Ptr
  While A <> @S
    If A->key = x Then Return A   ' Węzeł znaleziony
    If x < A->key Then
    	 A = A->Left
    Else
       A = A->Right
    End If
  Wend
  Return 0                        ' Węzeł nieznaleziony
End Function

' Dodaje do drzewa nowy węzeł, jesli w drzewie takiego węzła jeszcze nie ma
'--------------------------------------------------------------------------
Sub s_add ( ByRef A As RBTNode Ptr, byval x As Integer )
  If s_isin ( A, x ) = 0 Then insertRBT ( A, x )
End Sub

' Wyszukuje w drzewie węzeł o kluczu x i usuwa go
'------------------------------------------------
Sub s_remove ( ByRef A As RBTNode Ptr, ByVal x As Integer )
  Dim As RBTNode Ptr p = s_isin ( A, x ) ' Szukamy węzła o kluczu x
  If p Then removeRBT ( A, p )
End Sub

' Usuwa wszystkie węzły z drzewa
'-------------------------------
Sub s_clear ( ByRef A As RBTNode Ptr )
  If A <> @S Then
    s_clear ( A->left )           ' Rekurencyjnie usuwamy lewe poddrzewo
    s_clear ( A->right )          ' Rekurencyjnie usuwamy prawe poddrzewo
    Delete A                      ' Usuwamy węzeł
    A = @S
  End If
End Sub

' Procedura kopiuje elementy z drzewa A do C
'-------------------------------------------
Sub s_copy ( Byval A As RBTNode Ptr, ByRef C As RBTNode Ptr )
  If A <> @S Then
    s_add ( C, A->key )           ' Dodajemy do C klucz bieżącego węzła
    s_copy ( A->left, C )         ' Rekurencyjnie dodajemy do C lewe poddrzewo
    s_copy ( A->right, C )        ' Rekurencyjnie dodajemy do C prawe poddrzewo
  End If
End Sub

' Procedura tworzy sumę zbiorów A i B w C
'----------------------------------------
Sub s_union ( ByVal A As RBTNode Ptr, ByVal B As RBTNode Ptr, ByRef C As RBTNode Ptr )
  s_clear ( c )                   ' Czyścimy C
  s_copy ( A, C )                 ' W C umieszczamy A
  s_copy ( B, C )                 ' Dodajemy B do C
End Sub

' Procedura kopiuje do C te elementy A, które również są w B
'-----------------------------------------------------------
Sub s_icopy ( ByVal A As RBTNode Ptr, ByVal B As RBTNode Ptr, ByRef C As RBTNode Ptr )
  If A <> @S Then
    If s_isin ( B, A->key ) Then s_add ( C, A->key )
    s_icopy ( A->left, B, C )
    s_icopy ( A->right, B, C )
  End If
End Sub

' Procedura tworzy w C iloczyn zbiorów A i B
'-------------------------------------------
Sub s_intersection ( ByVal A As RBTNode Ptr, ByVal B As RBTNode Ptr, ByRef C As RBTNode Ptr )
  s_clear ( c )                   ' Czyścimy C
  s_icopy ( A, B, C )             ' Tworzymy iloczyn zbiorów
End Sub

' Procedura kopiuje do C te elementy A, których nie ma w B
'---------------------------------------------------------
Sub s_dcopy ( ByVal A As RBTNode Ptr, ByVal B As RBTNode Ptr, ByRef C As RBTNode Ptr )
  If A <> @S Then
    If s_isin ( B, A->key ) = 0 Then s_add ( C, A->key )
    s_dcopy ( A->left, B, C )
    s_dcopy ( A->right, B, C )
  End If
End Sub

' Procedura tworzy w C różnicę zbiorów A i B
'-------------------------------------------
Sub s_difference ( ByVal A As RBTNode Ptr, ByVal B As RBTNode Ptr, ByRef C As RBTNode Ptr )
  s_clear ( c )                   ' Czyścimy C
  s_dcopy ( A, B, C )             ' Tworzymy różnicę zbiorów
End Sub

' Funkcja zwraca true, jeśli zbiór A jest podzbiorem B
' Inaczej zwraca false
'-----------------------------------------------------
Function s_subset ( ByVal A As RBTNode Ptr, ByVal B As RBTNode Ptr ) As Integer
  If A = @S Then Return -1
  If s_isin ( B, A->key ) = 0  Then Return 0
  Return s_subset ( A->left, B ) AndAlso s_subset ( A->right, B )
End Function

' Procedura zlicza rekurencyjnie węzły w drzewie
'-----------------------------------------------
Sub s_cnt ( ByVal A As RBTNode Ptr, ByRef cnt As Integer )
  If A <> @S Then
    cnt += 1                      ' Zliczamy węzeł bieżący
    s_cnt ( A->left, cnt )        ' Rekurencyjnie liczymy węzły w lewym poddrzewie
    s_cnt ( A->right, cnt )       ' Rekurencyjnie liczymy węzły w prawym poddrzewie
  End If
End Sub

' Funkcja oblicza liczbę węzłów w drzewie
'----------------------------------------
Function s_size ( ByVal A As RBTNode Ptr ) As Integer
  Dim As Integer cnt = 0          ' Zerujemy licznik
  s_cnt ( A, cnt )                ' Zliczamy węzły
  Return cnt                      ' Zwracamy wynik
End Function

' Funkcja zwraca true, jeśli zbiór jest pusty
'--------------------------------------------
Function s_empty ( byval A As RBTNode Ptr ) As Integer
  Return A = @S
End Function

' Procedura rekurencyjnie wyświetla zawartość drzewa
'---------------------------------------------------
Sub s_print ( byval A As RBTNode Ptr )
  If A <> @S Then 
    s_print ( A->left )
    Print Using "& ";A->key;
    s_print ( A->right )
  End If
End Sub

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

Dim As RBTNode Ptr A, B, C, D
Dim As Integer i, x

Randomize                         ' Inicjujemy generator pseudolosowy

' Tworzymy puste zbiory

A = @S
B = @S
C = @S
D = @S

' Do zbioru A dodajemy 10 losowych elementów

For i = 1 To 10: s_add ( A, -20 + Int ( rnd( ) * 41 ) ): Next

' Do zbioru B dodajemy 15 losowych elementów

For i = 1 To 15: s_add ( B, -20 + Int ( rnd( ) * 41 ) ): Next

' Wyświetlamy je

Print "A:"
s_print ( A ): Print
Print "SIZE OF A IS";s_size ( A )
Print
Print "B:"
s_print ( B ): Print
Print "SIZE OF B IS";s_size ( B )
Print

' Suma zbiorów

Print "UNION OF A AND B:"
s_union ( A, B, C )
s_print ( c ): Print
Print "SIZE OF UNION IS";s_size ( c )
Print

' Iloczyn zbiorów

Print "INTERSECTION OF A AND B:"
s_intersection ( A, B, C )
s_print ( c ): Print
Print "SIZE OF INTERSECTION IS";s_size ( c )
Print

' Różnica zbiorów

Print "DIFFERENCE OF A AND B:"
s_difference ( A, B, C )
s_print ( c ): Print
Print "SIZE OF DIFFERENCE IS";s_size ( c )
Print

' Podzbiór

s_union ( A, A, C )               ' Kopiujemy A do C
For i = 1 To 7                    ' Usuwamy 7 elementów
  s_remove ( C, -20 + Int ( rnd( ) * 41 ) )
Next
Print "IS:";
s_print ( c )
Print " SUBSET OF A?"
If s_subset ( C, A ) Then
  Print "YES"
Else
  Print "NO"
End If
Print

s_difference ( B, A, C )
For i = 1 To 12                   ' Usuwamy 12 elementów
  s_remove ( C, -20 + Int ( rnd( ) * 41 ) )
Next
Print "IS:"
s_print ( c )
Print " SUBSET OF A?"
If s_subset ( C, A ) Then
  Print "YES"
Else
  Print "NO"
End If
Print

' Usuwanie

Print "FROM A WE REMOVE";
For i = 1 To 5
  x = -20 + Int ( rnd( ) * 41 )
  Print Using "& ";x;
  s_remove ( A, x )
Next
Print
Print "A:"
s_print ( A ): Print
Print "SIZE OF A IS";s_size ( A )
Print

' Sprawdzamy obecność wybranych elementów w B

For i = 1 To 10
  x = -20 + Int ( rnd( ) * 41 )
  Print Using "IS ELEMENT#### IN SET B? ";x;
  If s_isin ( B, x ) Then
  	 Print "YES"
  Else
  	 Print "NO"
  End If
Next
Print

' Sprawdzenie testu na zbiór pusty

Print "IS SET A EMPTY?"
If s_empty ( A ) Then
  Print "YES"
Else
  Print "NO"
End If
Print

Print "IS INTERSECTION OF A AND DIFFERENCE OF B AND A EMPTY?"
s_difference ( B, A, C )
s_intersection ( A, C, C )
If s_empty ( c ) Then
  Print "YES"
Else
  Print "NO"
End If
Print

' Usuwamy zbiory

s_clear ( A )
s_clear ( B )
s_clear ( c )
s_clear ( D )

End