type
  PBSTnode = ^BSTnode;
  BSTnode  = record
    up    : PBSTnode;
    left  : PBSTnode;
    right : PBSTnode;
    key   : typ_klucza;
    Data: typ_danych;
  end;
...
var
  // Wskazanie korzenia BST
  td : PBSTnode;
  // Liczba operacji na słowniku
  tc : integer;
...
const
  // założona liczba operacji
  // przed porządkowaniem DSW
  G = max_liczba_operacji;
...

struct BSTnode
{
  BSTnode * up;
  BSTnode * left;
  BSTnode * right;
  typ_klucza key;
  typ_danych data;
};
...
// Wskazanie korzenia BST
BSTnode * td;
// Liczba operacji na słowniku
int tc;
// założona liczba operacji
// przed porządkowaniem DSW
const int G = max_liczba_operacji;
...

Type BSTnode
  up    As BSTnode Ptr
  left  As BSTnode Ptr
  right As BSTnode Ptr
  key   As typ_klucza
  data  As typ_danych
End Type
...
' Wskazanie korzenia BST
Dim td As BSTDnode Ptr
' Liczba operacji na słowniku
Dim tc As Integer
// założona liczba operacji
// przed porządkowaniem DSW
Const G = max_liczba_operacji
...

// Program testowy dla słownika
// na drzewie BST
// Data: 18.11.2024
// (C)2024 mgr Jerzy Wałaszek
//---------------------------------------

program dBST_test;

type
  PBSTnode = ^BSTnode;
  BSTnode  = record
    up    : PBSTnode;
    left  : PBSTnode;
    right : PBSTnode;
    key   : string;
    Data: double;
  end;

const
  // założona liczba operacji
  // przed porządkowaniem DSW
  G = 4;
  // Wartość specjalna
  SV = -1000000.0;

// Procedura wstawia do drzewa BST
// węzeł o kluczu k i danych d
//--------------------------------
procedure insert_bst(var td : PBSTnode;
                          k : string;
                          d : double);
var
  w, p : PBSTnode;
begin
  new(w);
  w^.left  := nil;
  w^.right := nil;
  p := td;
  if p = nil then
    td := w
  else
    while true do
      if k < p^.key then
      begin
        if p^.left = nil then
        begin
          p^.left := w;
          break;
        end
        else p := p^.left;
      end
      else
      begin
        if p^.right = nil then
        begin
            p^.right := w;
            break;
        end
        else p := p^.right;
      end;
  w^.up   := p;
  w^.key  := k;
  w^.Data:= d;
end;

// Funkcja szuka w drzewie BST węzła
// o zadanym kluczu. Jeśli go znajdzie,
// zwraca jego wskazanie. Jeżeli nie,
// to zwraca wskazanie puste.
// Parametrami są:
// p - wskazanie korzenia drzewa BST
// k - klucz poszukiwanego węzła
//-------------------------------------
function find_bst(p : PBSTnode;
                  k : string)
                    : PBSTnode;
begin
  while(p <> nil) and (p^.key <> k) do
    if k < p^.key then
      p := p^.left
    else
      p := p^.right;
  find_bst := p;
end;

// Funkcja zwraca wskazanie węzła
// o najmniejszym kluczu. Parametrem
// jest wskazanie korzenia drzewa BST
//-----------------------------------
function min_bst(p : PBSTnode) : PBSTnode;
begin
  if p <> nil then
    while p^.left <> nil do
      p := p^.left;
  min_bst := p;
end;

// Funkcja znajduje następnik węzła p
//-----------------------------------
function succ_bst(p : PBSTnode) : PBSTnode;
var
  r : PBSTnode;
begin
  succ_bst := nil;
  if p <> nil then
  begin
    if p^.right <> nil then
      succ_bst := min_bst(p^.right)
    else
    begin
      r := p^.up;
      while(r <> nil) and (p = r^.right) do
      begin
        p := r;
        r := r^.up;
      end;
      succ_bst := r;
    end;
  end;
end;

// Procedura usuwa węzeł z drzewa BST
// td - referencja do zmiennej wskazującej
// węzeł
// x - wskazanie węzła do usunięcia
//----------------------------------------
procedure remove_bst(var td : PBSTnode;
                          x : PBSTnode);
var
  y, z : PBSTnode;
begin
  if x <> nil then
  begin
    if(x^.left = nil) or (x^.right = nil) then
      y := x
    else
      y := succ_bst(x);
    if y^.left <> nil then
      z := y^.left
    else
      z := y^.right;
    if z <> nil then z^.up := y^.up;
    if y^.up = nil then
      td := 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;
    Dispose(y);
  end;
end;

// Rotacja w lewo
//---------------
procedure rot_l(var root : PBSTnode;
                       A : PBSTnode);
var
  B, p : PBSTnode;
begin
  B := A^.right;
  if B <> nil then
  begin
    p := A^.up;
    A^.right := B^.left;
    if A^.right <> nil then
      A^.right^.up := A;
    B^.left := A;
    B^.up := p;
    A^.up := B;
    if p <> nil then
    begin
      if p^.left = A then
        p^.left := B
      else
        p^.right := B;
    end
    else root := B;
  end;
end;

// Rotacja w prawo
//----------------
procedure rot_r(var root : PBSTnode;
                       A : PBSTnode);
var
  B, p : PBSTnode;
begin
  B := A^.left;
  if B <> nil then
  begin
    p := A^.up;
    A^.left := B^.right;
    if A^.left <> nil then
      A^.left^.up := A;
    B^.right := A;
    B^.up := p;
    A^.up := B;
    if p <> nil then
    begin
      if p^.left = A then
        p^.left := B
      else
        p^.right := B;
    end
    else root := B;
  end;
end;

// Funkcja oblicza szybko 2^log2(x)
// Wartością tej funkcji jest liczba x,
// w której pozostawiono najstarszy bit 1
//---------------------------------------
function log2(x : dword) : dword;
var
  y : integer;
begin
  y := 1;
  x := x shr 1;
  while x > 0 do
  begin
    y := y shl 1;
    x := x shr 1;
  end;
  log2 := y;
end;

// Procedura równoważy drzewo BST
// td - referencja zmiennej
//      zawierającej adres korzenia
//-----------------------------------
procedure rebalance_dsw(var td : PBSTnode);
var
  n, i, s : dword;
  p     : PBSTnode;
begin
  n := 0;
  p := td;
  while p <> nil do
    if p^.left <> nil then
    begin
      rot_r(td, p);
      p := p^.up;
    end
    else
    begin
      inc(n);
      p := p^.right;
    end;
  s := n+1-log2(n+1);
  p := td;
  for i := 1 to s do
  begin
    rot_l(td, p);
    p := p^.up^.right;
  end;
  n := n-s;
  while n > 1 do
  begin
    n := n shr 1;
    p := td;
    for i := 1 to n do
    begin
      rot_l(td, p);
      p := p^.up^.right;
    end;
  end;
end;

// Równoważy drzewo po operacjach
procedure d_rebalance(var td : PBSTnode;
                      var tc : integer);
begin
  inc(tc);
  if tc >= G then
  begin
    tc := 0;
    rebalance_dsw(td);
  end;
end;

// Usuwa klucz k ze słownika
//--------------------------
procedure d_del(var td : PBSTnode;
                var tc : integer;
                     k : string);
var
  p : PBSTnode;
begin
  p := find_bst(td,k);
  if p <> nil then
  begin
    remove_bst(td,p);
    d_rebalance(td,tc);
  end;
end;

// Umieszcza w słowniku parę (k,v)
//--------------------------------
procedure d_put(var td : PBSTnode;
                var tc : Integer;
                     k : String;
                     d : double);
var
  p : PBSTnode;
begin
  p := find_bst(td, k);
  if p <> nil then
  begin
    p^.Data:= d;
    Exit;
  end;
  insert_bst(td, k, d);
  d_rebalance(td,tc);
end;

// Zwraca wartość v skojarzoną z kluczem k
// lub wartość specjalną SV, jeśli słownik
// nie zawiera klucza k.
function d_get(td : PBSTnode;
                k : string)
                  : double;
var
  p : PBSTnode;
begin
  p := find_bst(td, k);
  if p <> nil then Exit(p^.data);
  Exit(SV);
end;

// Rekurencyjna procedura DFS:preorder
procedure preorder_bst(var c : Integer;
                           v : PBSTnode);
begin
  if v <> nil then
  begin
    preorder_bst(c,v^.left);
    preorder_bst(c,v^.right);
    inc(c);
  end;
end;

// Oblicza liczbę kluczy w słowniku
//-----------------------------------------
function d_size(td : PBSTnode) : Integer;
var
  c : Integer;
begin
  c := 0; // zerujemy licznik
  preorder_bst(c,td);
  Exit(c);
end;

// Rekurencyjna procedura DFS:inorder
procedure inorder_bst(var i : Integer;
                          v : PBSTnode);
begin
  if v <> nil then
  begin
    inorder_bst(i,v^.left);
    writeln('Para #', i,
            ' k = ', v^.key,
            ' d = ', v^.data:5:2);
    Inc(i);
    inorder_bst(i,v^.right);
  end;
end;

// Procedura wyświetla zawartość słownika
//---------------------------------------
procedure d_print(td : PBSTnode);
var
  i : Integer;
begin
  writeln('Liczba kluczy : ', d_size(td));
  i := 1;
  inorder_bst(i,td);
  writeln;
end;

//---------------
// Program główny
//---------------

var
  // Klucze
  names : array[0..9] of string =
    ('Janusz', 'Marian',
     'Henryk', 'Adrian',
     'Bogdan', 'Cyprian',
     'Dariusz','Zenon',
     'Tadeusz','Karol');
  i,x : integer;
  v   : double;
  // Wskazanie korzenia BST
  td : PBSTnode;
  // Liczba operacji na słowniku
  tc : integer;
begin
  randomize();
  td := nil;
  // W słowniku umieszamy 7 danych
  writeln('TWORZENIE');
  for i := 1 to 7 do
  begin
    x  := random(10);
    v  := random * 10;
    d_put(td,tc,names[x],v);
    writeln('(',names[x],',',
            v:5:2,')');
  end;
  d_print(td);
  // Dodajemy 5 elementów
  writeln('DODAWANIE');
  for i := 1 to 5 do
  begin
    x  := random(10);
    v  := random * 10;
    d_put(td,tc,names[x],v);
    writeln('(',names[x],',',
            v:5:2,')');
  end;
  d_print(td);
  // Usuwamy 5 kluczy
  writeln('USUWANIE');
  for i := 1 to 5 do
  begin
    x := random(10);
    d_del(td,tc,names[x]);
    writeln('(',names[x],',*)');
  end;
  d_print(td);
  // Szukamy 10 kluczy
  writeln('WYSZUKIWANIE');
  for i := 1 to 10 do
  begin
    x := random(10);
    v := d_get(td,names[x]);
    if v <> SV then
    begin
      writeln('klucz ',
        names[x],
        ' obecny, v = ',
        v:5:2)
    end
    else
    begin
      writeln('klucza ',
      names[x],' brak');
    end;
  end;
  // Usuwamy słownik
  while td <> nil do
    d_del(td,tc,td^.key);
end.

// Program testowy dla słownika
// na drzewie BST
// Data: 18.11.2024
// (C)2024 mgr Jerzy Wałaszek
//---------------------------------------

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

using namespace std;

struct BSTnode
{
  BSTnode *up,*left,*right;
  string key;
  double data;
};
// założona liczba operacji
// przed porządkowaniem DSW
const int G = 4;
// Wartość specjalna
const double SV = -1000000.0;

// Wstawia do drzewa BST
// węzeł o kluczu k i danych d
//--------------------------------
void insert_bst(BSTnode * & td,
                string k,
                double d)
{
  BSTnode * w, * p;

  w = new BSTnode;
  w->left  = nullptr;
  w->right = nullptr;
  p = td;
  if(!p) td = w;
  else
    while(true)
      if(k < p->key)
      {
        if(!p->left)
        {
          p->left = w;
          break;
        }
        else p = p->left;
      }
      else
      {
        if(!p->right)
        {
            p->right = w;
            break;
        }
        else p = p->right;
      }
  w->up   = p;
  w->key  = k;
  w->data = d;
}

// Funkcja szuka w drzewie BST węzła
// o zadanym kluczu. Jeśli go znajdzie,
// zwraca jego wskazanie. Jeżeli nie,
// to zwraca wskazanie puste.
// Parametrami są:
// p - wskazanie korzenia drzewa BST
// k - klucz poszukiwanego węzła
//-------------------------------------
BSTnode * find_bst(BSTnode * p,
                   string k)
{
  while(p && p->key != k)
    if(k < p->key)
      p = p->left;
    else
      p = p->right;
  return p;
}

// Funkcja zwraca wskazanie węzła
// o najmniejszym kluczu. Parametrem
// jest wskazanie korzenia drzewa BST
//-----------------------------------
BSTnode * min_bst(BSTnode * p)
{
  if(p)
    while(p->left) p = p->left;
  return p;
}

// Funkcja znajduje następnik węzła p
//-----------------------------------
BSTnode * succ_bst(BSTnode * p)
{
  if(!p) return p;
  if(p->right)
    return min_bst(p->right);
  else
  {
    BSTnode * r = p->up;
    while(r && p == r->right)
    {
      p = r;
      r = r->up;
    }
    return r;
  }
}

// Procedura usuwa węzeł z drzewa BST
// td - referencja do zmiennej wskazującej
// węzeł
// x - wskazanie węzła do usunięcia
//----------------------------------------
void remove_bst(BSTnode * & td,
                BSTnode * x)
{
  BSTnode * y, * z;

  if(x)
  {
    if(!x->left || !x->right)
      y = x;
    else
      y = succ_bst(x);
    if(y->left)
      z = y->left;
    else
      z = y->right;
    if(z) z->up = y->up;
    if(!y->up)
      td = z;
    else
      if(y == y->up->left)
        y->up->left = z;
      else
        y->up->right = z;
    if(y != x) x->key = y->key;
    delete y;
  }
}

// Rotacja w lewo
//---------------
void rot_l(BSTnode * & root, BSTnode * A)
{
  BSTnode * B, * p;

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

// Rotacja w prawo
//----------------
void rot_r(BSTnode * & root,
           BSTnode * A)
{
  BSTnode * B, * p;

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

// Funkcja oblicza szybko 2^log2(x)
// Wartością tej funkcji jest liczba x,
// w której pozostawiono najstarszy bit 1
//---------------------------------------
unsigned log2(unsigned x)
{
  unsigned y = 1;

  while((x >>= 1) > 0) y <<= 1;

  return y;
}

// Procedura równoważy drzewo BST
// td - referencja zmiennej
//      zawierającej adres korzenia
//-----------------------------------
void rebalance_dsw(BSTnode * & td)
{
  unsigned n, i, s;
  BSTnode * p;

  // W n zliczamy węzły
  n = 0;
  // Rozpoczynamy tworzenie listy liniowej
  p = td;
  // Dopóki jesteśmy w drzewie
  while(p)
    // Jeśli przetwarzany węzeł ma
    // lewego syna,
    if(p->left)
    {
       // to obracamy wokół niego
       // drzewo w prawo
       rot_r(td, p);
       p = p->up;
    }
    else
    {
      // Inaczej zwiększamy licznik węzłów
      n++;
      // i przesuwamy się do
      // prawego syna
      p = p->right;
    }
  // Teraz z listy tworzymy drzewo BST
  // Wyznaczamy początkową liczbę obrotów
  s = n + 1 - log2(n + 1);

  // Rozpoczynamy od początku drzewa
  p = td;
  // Zadaną liczbę razy
  for(i = 0; i < s; i++)
  {
    // co drugi węzeł obracamy w lewo
    rot_l(td, p);
    p = p->up->right;
  }

  // Wyznaczamy kolejne liczby obrotów
  n -= s;

  // Powtarzamy procedurę obrotów węzłów
  while(n > 1)
  {
    // Jednakże wyznaczając za każdym razem
    // odpowiednio mniejszą liczbę obrotów,
    // która maleje z potęgami 2
    n >>= 1;
    p = td;
    for(i = 0; i < n; i++)
    {
      rot_l(td, p);
      p = p->up->right;
    }
  }
}

// Równoważy drzewo po operacjach
void d_rebalance(BSTnode * & td, int & tc)
{
  tc++;
  if(tc >= G)
  {
    tc = 0;
    rebalance_dsw(td);
  }
}

// Usuwa klucz k ze słownika
//--------------------------
void d_del(BSTnode * & td,
           int & tc,
           string k)
{
  BSTnode * p = find_bst(td,k);
  if(p)
  {
    remove_bst(td,p);
    d_rebalance(td,tc);
  }
}

// Umieszcza w słowniku parę (k,v)
//--------------------------------
void d_put(BSTnode * & td,
           int & tc,
           string k,
           double d)
{
  BSTnode * p = find_bst(td, k);
  if(p)
  {
    p->data = d;
    return;
  }
  insert_bst(td, k, d);
  d_rebalance(td,tc);
}

// Zwraca wartość v skojarzoną z kluczem k
// lub wartość specjalną SV, jeśli słownik
// nie zawiera klucza k.
double d_get(BSTnode * td, string k)
{
  BSTnode * p = find_bst(td, k);
  if(p) return p->data;
  return SV;
}

// Rekurencyjna procedura DFS:preorder
void preorder_bst(int & c, BSTnode * v)
{
  if(v)
  {
    preorder_bst(c,v->left);
    preorder_bst(c,v->right);
    c++;
  }
}

// Oblicza liczbę kluczy w słowniku
//-----------------------------------------
int d_size(BSTnode * td)
{
  int c = 0; // zerujemy licznik
  preorder_bst(c,td);
  return c;
}

// Rekurencyjna procedura DFS:inorder
void inorder_bst(int & i, BSTnode * v)
{
  if(v)
  {
    inorder_bst(i,v->left);
    cout << "Para #" << i
         << " k = " << v->key
         << " d == "
         << setw(5) << v->data
         << endl;
    i++;
    inorder_bst(i,v->right);
  }
}

// Procedura wyświetla zawartość słownika
//---------------------------------------
void d_print(BSTnode * td)
{
  int i = 1;
  cout << "Liczba kluczy : "
       << d_size(td) << endl;
  inorder_bst(i,td);
  cout << endl;
}

//---------------
// Program główny
//---------------

int main()
{
 // Klucze
  string names[] =
    {"Janusz", "Marian",
     "Henryk", "Adrian",
     "Bogdan", "Cyprian",
     "Dariusz","Zenon",
     "Tadeusz","Karol"};
  int i,x;
  double v;
  // Wskazanie korzenia BST
  BSTnode * td;
  // Liczba operacji na słowniku
  int tc;

  srand(time(nullptr));
  cout << fixed << setprecision(2);
  td = nullptr;
  // W słowniku umieszamy 7 danych
  cout << "TWORZENIE" << endl;
  for(i = 0; i < 7; i++)
  {
    x  = rand()%10;
    v  = 10*rand()/double(RAND_MAX);
    d_put(td,tc,names[x],v);
    cout << "(" << names[x]
         << "," << setw(5)
         << v << endl;
  }
  d_print(td);

  // Dodajemy 5 elementów
  cout << "DODAWANIE" << endl;
  for(i = 0; i < 5; i++)
  {
    x  = rand()%10;
    v  = 10*rand()/double(RAND_MAX);
    d_put(td,tc,names[x],v);
    cout << "(" << names[x]
         << "," << setw(5)
         << v << endl;
  }
  d_print(td);

  // Usuwamy 5 kluczy
  cout << "USUWANIE" << endl;
  for(i = 0; i < 5; i++)
  {
    x  = rand()%10;
    d_del(td,tc,names[x]);
    cout << "(" << names[x]
         << ",*)" << endl;
  }
  d_print(td);

  // Szukamy 10 kluczy
  cout << "WYSZUKIWANIE" << endl;
  for(i = 0; i < 10; i++)
  {
    x  = rand()%10;
    v = d_get(td,names[x]);
    if(v != SV)
      cout << "klucz " << names[x]
           << " obecny, v = "
           << setw(5) << v << endl;
    else
      cout << "klucza " << names[x]
           << " brak" << endl;
  }

  // Usuwamy słownik z pamięci
  while(td)
    d_del(td,tc,td->key);
  return 0;
}

' Program testowy dla słownika
' na drzewie BST
' Data: 19.11.2024
' (C)2024 mgr Jerzy Wałaszek
'---------------------------------------

Type BSTnode
    up    As BSTnode Ptr
    left  As BSTnode Ptr
    right As BSTnode Ptr
    key   As String
    data  As Double
End Type

' założona liczba operacji
' przed porządkowaniem DSW
Const G = 4
' Wartość specjalna
Const SV = -1000000.0

' Procedura wstawia do drzewa BST
' węzeł o kluczu k i danych d
'--------------------------------
Sub insert_bst(ByRef td As BSTnode Ptr, _
               ByRef  k As String, _
               ByVal  d As Double)
  Dim As BSTnode Ptr w, p

  w = New BSTnode
  w->left  = 0
  w->right = 0
  p = td
  If p = 0 Then
    td = w
  Else
    While 1
      If k < p->key Then
        If p->left = 0 Then
          p->left = w
          Exit While
        Else
          p = p->left
        End If
      Else
        If p->right = 0 Then
          p->right = w
          Exit While
        Else
          p = p->right
        End If  
      End If
    Wend
  End If
  w->up   = p
  w->key  = k
  w->data = d
End Sub

' Funkcja szuka w drzewie BST węzła
' o zadanym kluczu. Jeśli go znajdzie,
' zwraca jego wskazanie. Jeżeli nie,
' to zwraca wskazanie puste.
' Parametrami są:
' p - wskazanie korzenia drzewa BST
' k - klucz poszukiwanego węzła
'-------------------------------------
Function find_bst(ByVal p As BSTnode Ptr, _
                  ByRef k As String) _
                          As BSTnode Ptr
  While (p <> 0) AndAlso (p->key <> k)
    If k < p->key Then
      p = p->left
    Else
      p = p->right
    End If
  Wend
  Return p
End Function

' Funkcja zwraca wskazanie węzła
' o najmniejszym kluczu. Parametrem
' jest wskazanie korzenia drzewa BST
'-----------------------------------
Function min_bst(ByVal p As BSTnode Ptr) _
                         As BSTnode Ptr
  If p <> 0 Then
    While p->left <> 0
      p = p->left
    Wend
  End If
  Return p
End Function

' Funkcja znajduje następnik węzła p
'-----------------------------------
Function succ_bst(ByVal p As BSTnode Ptr) _
                          As BSTnode Ptr
  Dim As BSTnode Ptr r

  If p = 0 Then Return 0
  
  If p->right <> 0 Then
    Return  min_bst(p->right)
  Else
    r = p->up
    While (r <> 0) AndAlso (p = r->right)
      p = r
      r = r->up
    Wend
  End If
  Return r
End Function

' Procedura usuwa węzeł z drzewa BST
' td - referencja do zmiennej wskazującej
' węzeł
' x - wskazanie węzła do usunięcia
'----------------------------------------
Sub remove_bst(ByRef td As BSTnode Ptr, _
               ByVal  x As BSTnode Ptr)
  Dim As BSTnode Ptr y, z

  If x <> 0 Then
    If (x->left = 0) Or _
       (x->right = 0) Then
      y = x
    Else
      y = succ_bst(x)
    End If
    If y->left <> 0 Then
      z = y->left
    Else
      z = y->right
    End If
    If z <> 0 Then z->up = y->up
    If y->up = 0 Then
      td = z
    Else
      If y = y->up->left Then
        y->up->left  = z
      Else
        y->up->right = z
      End If
    End If
    If y <> x Then x->key = y->key
    Delete y
  End If
End Sub

' Rotacja w lewo
'---------------
Sub rot_l(ByRef root As BSTnode Ptr, _
          ByVal A    As BSTnode Ptr)
  Dim As BSTnode Ptr B, p

  B = A->right
  If B <> 0 Then
    p = A->up
    A->right = B->left
    If A->right <> 0 Then _
      A->right->up = A
    B->left = A
    B->up = p
    A->up = B
    If p <> 0 Then
      If p->left = A Then
        p->left = B
      Else
        p->right = B
      End If
    Else
      root = B
    End If
  End If
End Sub

' Rotacja w prawo
'----------------
Sub rot_r(ByRef root As BSTnode Ptr, _
          ByVal    A As BSTnode Ptr)
  Dim As BSTnode Ptr B, p

  B = A->left
  If B <> 0 Then
    p = A->up
    A->left = B->right
    If A->left <> 0 Then _
      A->left->up = A
    B->right = A
    B->up = p
    A->up = B
    If p <> 0 Then
      If p->left = A Then
        p->left = B
      Else
        p->right = B
      End If
    Else
      root = B
    End If
  End If
End Sub

' Funkcja oblicza szybko 2^log2(x)
' Wartością tej funkcji jest liczba x,
' w której pozostawiono najstarszy bit 1
'---------------------------------------
Function log2(ByVal x As Integer) _
                      As Integer
  Dim As Integer y

  y = 1
  x = x Shr 1
  While x > 0
    y = y Shl 1
    x = x Shr 1
  Wend
  Return y
End Function

' Procedura równoważy drzewo BST
' td - referencja zmiennej
'      zawierającej adres korzenia
'-----------------------------------
Sub rebalance_dsw(ByRef td As BSTnode Ptr)
  Dim As Integer n, i, s
  Dim As BSTnode Ptr p

  n = 0
  p = td
  While p <> 0
    If p->left <> 0 Then
      rot_r td, p
      p = p->up
    Else
      n += 1
      p = p->right
    End If
  Wend
  s = n + 1 - log2(n+1)
  p = td
  For i = 1 To s
    rot_l td, p
    p = p->up->right
  Next
  n = n - s
  While n > 1
    n = n shr 1
    p = td
    For i = 1 To n
      rot_l td, p
      p = p->up->right
    Next
  Wend
End Sub

' Równoważy drzewo po operacjach
Sub d_rebalance(ByRef td As BSTnode Ptr, _
                ByRef tc As Integer)
  tc += 1
  If tc >= G Then
    tc = 0
    rebalance_dsw td
  End If
End Sub

' Usuwa klucz k ze słownika
'--------------------------
Sub d_del(ByRef td As BSTnode Ptr, _
          ByRef tc As Integer, _
          ByRef  k As String)
  Dim As BSTnode Ptr p

  p = find_bst(td, k)
  If p <> 0 then
    remove_bst td, p
    d_rebalance td, tc
  End If
End Sub

' Umieszcza w słowniku parę (k,v)
'--------------------------------
Sub d_put(ByRef td As BSTnode Ptr, _
          ByRef tc As Integer, _
          ByRef  k As String, _
          ByVal  d As Double)
  Dim As BSTnode Ptr p

  p = find_bst(td, k)
  If p <> 0 Then
    p->data = d
    Return
  End If
  insert_bst td, k, d
  d_rebalance td, tc
End Sub

' Zwraca wartość v skojarzoną z kluczem k
' lub wartość specjalną SV, jeśli słownik
' nie zawiera klucza k.
Function d_get(ByVal td As BSTnode Ptr, _
               ByRef  k As String) _
                        As Double
  Dim As BSTnode Ptr p

  p = find_bst(td, k)
  If p <> 0 Then Return p->data
  Return SV
End Function

' Rekurencyjna procedura DFS:preorder
Sub preorder_bst(ByRef c As Integer, _
                 ByVal v As BSTnode Ptr)
  If v <> 0 Then
    preorder_bst c, v->left
    preorder_bst c, v->right
    c += 1
  End If
End Sub

' Oblicza liczbę kluczy w słowniku
'-----------------------------------------
Function d_size(ByVal td As BSTnode Ptr) _
                         As Integer
  Dim As Integer c

  c = 0 ' zerujemy licznik
  preorder_bst c, td
  Return c
End Function

' Rekurencyjna procedura DFS:inorder
Sub inorder_bst(ByRef i As Integer, _
                ByVal v As BSTnode Ptr)
  If v <> 0 Then
    inorder_bst i, v->left
    Print "Para #"; i; " k = "; v->key;
    Print Using " d = ##.##"; v->data
    i += 1
    inorder_bst i, v->right
  End If
End Sub

' Procedura wyświetla zawartość słownika
'---------------------------------------
Sub d_print(ByVal td As BSTnode Ptr)
  Dim As Integer i

  Print "Liczba kluczy : "; d_size(td)
  i = 1
  inorder_bst i, td
  Print
End Sub

'---------------
' Program główny
'---------------

' Klucze
Dim As String names(9) = _
    {"Janusz", "Marian", _
     "Henryk", "Adrian", _
     "Bogdan", "Cyprian",_
     "Dariusz","Zenon",  _
     "Tadeusz","Karol"}
Dim As Integer i,x
Dim As Double v
Dim As BSTnode Ptr td ' Słownik
' Liczba operacji na słowniku
Dim As Integer tc

Randomize
td = 0

' W słowniku umieszamy 7 danych
Print "TWORZENIE"
For i = 1 To 7
  x = Int(Rnd*10)
  v = Rnd*10
  d_put td, tc, names(x), v
  Print "(";names(x);",";
  Print Using "##.##";v
Next
d_print td

' Dodajemy 5 elementów
Print "DODAWANIE"
For i = 1 To 5
  x = Int(Rnd*10)
  v = Rnd*10
  d_put td, tc, names(x), v
  Print "(";names(x);",";
  Print Using "##.##)";v
Next  
d_print td

' Usuwamy 5 kluczy
Print "USUWANIE"
For i = 1 To 5
  x = Int(Rnd*10)
  d_del td, tc, names(x)
  Print "(";names(x);",*)"
Next
d_print td

' Szukamy 10 kluczy
Print "WYSZUKIWANIE"
For i = 1 To 10
  x = Int(Rnd*10)
  v = d_get(td, names(x))
  If v <> SV Then
    Print "klucz ";names(x);" obecny, v = ";
    Print Using "##.##";v
  Else
    Print "klucza ";names(x);" brak"
  End If
Next

' Usuwamy słownik z pamięci
While td <> 0
  d_del td, tc, td->key
Wend
End