{ AVL - Test, fuer Datenstrukturen, SS03, Benn }
{ Autor: Dipl.-Ing. Thomas Speiser             }
{ Source from: http://Codes.TurboTools.de      }

program test_avl;
uses Crt;
type ref = ^baum;
     baum = record
     value: integer;
     balance: integer; {  0 - Balance ausgeglichen (Hoehe links = Hoehe rechts)
                         +1 - Balance rechtslastig (Hoehe links < Hoehe rechts)
                         -1 - Balance linkslastig  (Hoehe links > Hoehe rechts) }
     left, right: ref;
end;

var tree: ref;

{
  Fall1: Fuege an einem Links- (bzw. rechts) lastigen Knoten
         rechts (bzw. links) ein.
         => Bal. nun = 0              0       B1 => B0
         Hoehe unveraendert           1   0

  Fall2: Am balancierten Knoten wurde der linke Teilbaum vergroessert.
                                      0       B0 => B-1
                                    0   0
                                          1                                          1
         => Bal. = -1
         Hoehe hat sich veraendert

  Fall3: Am balancierten Knoten wurde rechter Teilbaum vergroessert
         => Bal. = +1

  Fall4: An einem links- (bzw. rechts) lastigem Knoten wurde der linke
         (bzw. rechte) Teilbaum vergroessert.
         => AVL-Eigenschaft verletzt
  Fall4.1:
         Links-Lastig, links eingefuegt          0    LL       0
                                              0   0        0     0
                                            0        =>  1   0
                                          1

        (Doppelte Rotation)                     0    LR
                                             0     0
                                          0    0
                                             1
}

procedure Insert_Node(var tree: ref; i: integer);
begin
 if tree = nil then
 begin
   new(tree);
   tree^.left:=nil;
   tree^.right:=nil;
   tree^.value:=i;
   tree^.balance:=-2;
   writeLN(i,'. hinzugefuegt!');
  end else
  begin
   if i < tree^.value then
  begin
   Insert_Node(tree^.left,i);
  end else
  begin
   Insert_Node(tree^.right,i);
   end;
 end;
end;

function Height(tree: ref): byte;
var lefttree, righttree: byte;
begin
 if tree = nil then height:=0
 else begin
    lefttree:=height(tree^.left)+1;
    righttree:=height(tree^.right)+1;
 if lefttree > righttree then
    height:=lefttree else height:=righttree;
 end;
end;

function balance(tree: ref): integer;
var lb, rb: byte;
begin
 lb:=height(tree^.left);
 rb:=height(tree^.right);
 if lb = rb then balance:=0
 else balance:=rb - lb
end;

procedure Draw_Tree(var tree: ref; tiefe: integer);
var i: byte;
begin
if tree <> nil then
  begin
   draw_tree(tree^.right,tiefe+1);
   for i:=1 to tiefe do write('  ');
   writeln(tree^.value,'(',tree^.balance,') ');
   draw_tree(tree^.left,tiefe+1);
  end;
end;

procedure Balance_zuweisen(var tree: ref);
begin
 if tree <> nil then
 begin
      { Balance - Urzustand = -2 }
      tree^.balance:=balance(tree);
      balance_zuweisen(tree^.left);
      balance_zuweisen(tree^.right);
 end;
end;

{ Ueberpruefung ob balanciert ist oder nicht }
function AVL_Check(tree: ref): boolean;
var test: boolean;

{ Durchlauf-Test }
  procedure run(w: ref; var error: boolean);
  begin
   if w <> nil then
   begin
      if (w^.balance < -1) or (w^.balance > 1) then error:=false;
      run(w^.left,error);
      run(w^.right,error);
    end;
 end;

begin
 test:=true;
 run(tree,test);
 avl_check:=test;
end;

{ Rotations - Auswahl }
procedure rotate(node: ref);

  procedure ll_rotation(var k: ref); { nach rechts rotieren }
  var k1: ref;
    begin
    k1:=k^.left;
    if k1^.balance = -1 then begin
    k^.left:=k1^.right;
    k1^.right:=k;
    k^.balance:=0;
    k:=k1; end;
    end;

  procedure lr_rotation(var k: ref); { zuerst nach links rotieren, dann nach rechts }
  var k1,k2: ref;
    begin
    k1:=k^.left;
    k2:=k1^.right;
    k1^.right:=k2^.left;
    k^.left:=k2^.right;
    k2^.left:=k1;
    k2^.right:=k;
    k:=k2;
    end;

  procedure rr_rotation(var k: ref); { nach links rotieren }
  var k1: ref;
    begin
    k1:=k^.right;
    if k1^.balance = 1 then begin
    k^.right:=k1^.left;
    k1^.left:=k;
    k^.balance:=0;
    k:=k1; end;
    end;

  procedure rl_rotation(var k: ref); { zuerst nach rechts rotieren, dann nach links }
  var k1,k2: ref;
    begin
    k1:=k^.right;
    k2:=k1^.left;
    k1^.left:=k2^.right;
    k^.right:=k2^.left;
    k2^.left:=k;
    k2^.right:=k1;
    k:=k2;
    end;

begin
if (node^.left^.balance < -1) and (avl_check(node^.left) = false) then
begin
 writeLN('LL-Rotation: ',node^.left^.value);
 ll_rotation(node^.left);
 node:=node^.left;
end;

if (node^.balance < -1)      and
   (node^.left^.balance > 0) and (avl_check(node) = false) then
begin
 writeLN;
 writeLN('LR-Rotation: ',node^.value);
 lr_rotation(node);
 tree:=node;
end;

if (node^.balance > 1) and (node^.right^.balance > 0) and
   (avl_check(node) = false) then
begin
 writeLN;
 writeLN('RR-Rotation: ',node^.value);
 rr_rotation(node);
 tree:=node;
end;

if (node^.balance > 1)        and
   (node^.right^.balance < 0) and (avl_check(node) = false) then
begin
 writeLN;
 writeLN('RL-Rotation: ',node^.value);
 rl_rotation(node);
 tree^.right:=node;
end;

end;

procedure rotate_correction(var node: ref);
begin
if node <> nil then
begin
 rotate_correction(node^.left);
 rotate_correction(node^.right);
 if avl_check(node) = false then rotate(node);
end;
end;

begin
{ Standard-Baum erstellen! }

      ClrScr;
      TextMode(CO80 xor Lo(LastMode)+Font8x8 xor LASTMODE);
{ Test LL-Rotation }
{      insert_Node(tree,8);
      insert_Node(tree,4);
      insert_Node(tree,10);
      insert_Node(tree,2);
{ Test RR-Rotation }
{      insert_Node(tree,4);
      insert_Node(tree,6);
{ Test LR-Rotation }
{      insert_Node(tree,8);
      insert_Node(tree,2);
      insert_Node(tree,10);
      insert_Node(tree,1);
      insert_Node(tree,4);
{ Test RL-Rotation }
      insert_Node(tree,4);
      insert_Node(tree,2);
      insert_Node(tree,8);
      insert_Node(tree,1);
      insert_Node(tree,3);
      insert_Node(tree,10);
{}
      Balance_zuweisen(tree);
      writeLN;
      draw_tree(tree,1);
{ Test LL-Rotation }
{      insert_Node(tree,1);
{ Test RR-Rotation }
{      insert_Node(tree,7);
{ Test LR-Rotation }
{      insert_Node(tree,3);
{ Test RL-Rotation }
      insert_Node(tree,9);
{}    writeLN('Ist Baum balanciert: ',Avl_check(tree));

      Balance_zuweisen(tree);
      writeLN;
      draw_tree(tree,1);
      writeLN('Ist Baum balanciert: ',Avl_check(tree));

      rotate_correction(tree);
      Balance_zuweisen(tree);
      draw_tree(tree,1);
      writeLN('Ist Baum balanciert: ',Avl_check(tree));

      readLN;
end.