Atari Computer

Beispiel: AVL-Baum

Die folgenden Beispiele zeigen einen ausbalancierten AVL-Baum.

Sprache	C	Pascal	Modula
Beispiel	avl.c	avl.pas	avl.mod

avl.c

/* Da der Datentyp des AVL-Baums erst bei einer konkreten */
/* Anwendung feststeht, ist der Baum nur als Beispiel und */
/* nicht als Modul programmiert.                          */

#include 
#include 

#define AVL_MAX_HEIGHT 32

typedef long AvlKeyType;
typedef struct avl_knoten {
   AvlKeyType Key;
   short Bal;
   short cache; /* Used during insertion */
   struct avl_knoten *Link[2];
} AvlElement, *AvlKnoten;
typedef AvlKnoten AvlBaum;

void AvlCreate(AvlBaum *tree)
{
   *tree = NULL;
}

void AvlInsert(AvlBaum *tree, AvlKeyType key)
{
   /* Uses Knuth's Algorithm 6.2.3A (balanced tree search and
      insertion), but caches results of comparisons. In empirical
      tests this eliminates about 25% of the comparisons seen under
      random insertions. */

   /* A1. */
   AvlKnoten t, s, p, q, r, this;

   this = malloc(sizeof(AvlElement));
   if (this != NULL)
   {
      this->Bal = 0;
      if (*tree == NULL)
         *tree = this;
      else
      {
         t = *tree;
         s = p = *tree;
         for (;;)
         {
            /* A2. */
            /* compare, included in  A3, Michael Bernstein */
            /* A3. */
            if (key < p->Key)
            {
               p->cache = 0;
               q = p->Link[0];
               if (q == NULL)
               {
                  p->Link[0] = q = this;
                  break;
               }
            }
            /* A4. */
            else if (key > p->Key)
            {
               p->cache = 1;
               q = p->Link[1];
               if (q == NULL)
               {
                  p->Link[1] = q = this;
                  break;
               }
            }
            /* A3, A4. */
            if (q->Bal != 0)
            {
               t = p;
               s = q;
            }
            p = q;
         }
         /* A5. */
         this->Link[0] = NULL;
         this->Link[1] = NULL;
         /* A6. */
         r = p = s->Link[s->cache];
         while (p != q)
         {
            p->Bal = p->cache * 2 - 1;
            p = p->Link[p->cache];
         }
         /* A7. */
         if (s->cache == 0)
         {
            /* a = -1. */
            if (s->Bal == 0)
            {
               s->Bal = -1;
               return;
            }
            else if (s->Bal == 1)
            {
               s->Bal = 0;
               return;
            }
            if (r->Bal == -1)
            {
               /* A8. */
               p = r;
               s->Link[0] = r->Link[1];
               r->Link[1] = s;
               s->Bal = r->Bal = 0;
            }
            else
            {
               /* A9. */
               p = r->Link[1];
               r->Link[1] = p->Link[0];
               p->Link[0] = r;
               s->Link[0] = p->Link[1];
               p->Link[1] = s;
               if (p->Bal == -1)
               {
                  s->Bal = 1;
                  r->Bal = 0;
               }
               else if (p->Bal == 0)
                  s->Bal = r->Bal = 0;
               else 
               {
                  s->Bal = 0;
                  r->Bal = -1;
               }
               p->Bal = 0;
            }
         }
         else
         {
            /* a == +1. */
            if (s->Bal == 0)
            {
               s->Bal = 1;
               return;
            }
            else if (s->Bal == -1)
            {
               s->Bal = 0;
               return;
            }
            if (r->Bal == 1)
            {
               /* A8. */
               p = r;
               s->Link[1] = r->Link[0];
               r->Link[0] = s;
               s->Bal = r->Bal = 0;
            }
            else
            {
               /* A9. */
               p = r->Link[0];
               r->Link[0] = p->Link[1];
               p->Link[1] = r;
               s->Link[1] = p->Link[0];
               p->Link[0] = s;
               if (p->Bal == 1)
               {
                  s->Bal = -1;
                  r->Bal = 0;
               }
               else if (p->Bal == 0)
                  s->Bal = r->Bal = 0;
               else 
               {
                  s->Bal = 0;
                  r->Bal = 1;
               }
               p->Bal = 0;
            }
         }
         /* A10. */
         /*if (t != *tree && s == t->Left)*/
         if (s == t->Link[1])
            t->Link[1] = p;
         else if (s == t->Link[0])
            t->Link[0] = p;
         else
            *tree = p;
      }
   }
}

void AvlRemove(AvlBaum *tree, AvlKeyType Key)
{
   /* Uses my Algorithm D, which can be found at
      http://www.msu.edu/user/pfaffben/avl.  Algorithm D is based on
      Knuth's Algorithm 6.2.2D (Tree deletion) and 6.2.3A (Balanced
      tree search and insertion), as well as the notes on pages 465-466
      of Vol. 3. */

   /* D1. */
   AvlElement Dummy;
   AvlKnoten pa[AVL_MAX_HEIGHT]; /* Stack P: Nodes. */
   short a[AVL_MAX_HEIGHT];      /* Stack P: Bits. */
   int k;                        /* Stack P: Pointer. */
   AvlKnoten *q, p, r, s;
   int l;

   /* insert dummy entry because access to k-1 is used */
   /* and this can generate access to pa[0], but we dont */
   /* want to modify any node in the tree */
   a[0] = 0;
   pa[0] = &Dummy;
   Dummy.Key = 0;
   Dummy.Link[0] = NULL;
   Dummy.Link[1] = NULL;
   p = *tree;
   k = 1;
   for (;;)
   {
      /* D2. */
      if (p == NULL)
         return;
      if (Key == p->Key)
         break;
      /* D3, D4. */
      pa[k] = p;
      if (Key < p->Key)
      {
         p = p->Link[0];
         a[k] = 0;
      }
      else if (Key > p->Key)
      {
         p = p->Link[1];
         a[k] = 1;
      }
      k++;
   }
   /* D5. */
   q = &(pa[k - 1]->Link[a[k - 1]]);
   if (p->Link[1] == NULL)
   {
      *q = p->Link[0];
      if (*q)
         (*q)->Bal = 0;
   }
   else
   {
      /* D6. */
      r = p->Link[1];
      if (r->Link[0] == NULL)
      {
         r->Link[0] = p->Link[0];
         *q = r;
         r->Bal = p->Bal;
         a[k] = 1;
         pa[k++] = r;
      }
      else
      {
         /* D7. */
         s = r->Link[0];
         l = k++;
         a[k] = 0;
         pa[k++] = r;
         /* D8. */
         while (s->Link[0] != NULL)
         {
            r = s;
            s = r->Link[0];
            a[k] = 0;
            pa[k++] = r;
         }
         /* D9. */
         a[l] = 1;
         pa[l] = s;
         s->Link[0] = p->Link[0];
         r->Link[0] = s->Link[1];
         s->Link[1] = p->Link[1];
         s->Bal = p->Bal;
         *q = s;
      }
   }
   if (p == *tree)
   {
      /* Michael Bernstein: delete tree, we had to set new tree */
      *tree = *q;
   }
   /* Michael Bernstein: else tree is unchanged */
   free(p);
   /* D10. */
   while (--k)
   {
      s = pa[k];
      if (a[k] == 0)
      {
         /* D10. */
         if (s->Bal == -1)
         {
            s->Bal = 0;
            continue;
         }
         else if (s->Bal == 0)
         {
            s->Bal = 1;
            break;
         }
         r = s->Link[1];
         if (r->Bal == 0)
         {
            /* D11. */
            s->Link[1] = r->Link[0];
            r->Link[0] = s;
            r->Bal = -1;
            pa[k - 1]->Link[a[k - 1]] = r;
            if (*tree == s)
            {
               /* Michael Bernstein: if k == 1 we have to set new root into tree */
               *tree = r;
            }
            break;
         }
         else if (r->Bal == 1)
         {
            /* D12. */
            s->Link[1] = r->Link[0];
            r->Link[0] = s;
            s->Bal = r->Bal = 0;
            pa[k - 1]->Link[a[k - 1]] = r;
            if (*tree == s)
            {
               /* Michael Bernstein: if k == 1 we have to set new root into tree */
               *tree = r;
            }
         }
         else
         {
            /* D13. */
            p = r->Link[0];
            r->Link[0] = p->Link[1];
            p->Link[1] = r;
            s->Link[1] = p->Link[0];
            p->Link[0] = s;
            if (p->Bal == 1)
            {
               s->Bal = -1;
               r->Bal = 0;
            }
            else if (p->Bal == 0)
               s->Bal = r->Bal = 0;
            else
            {
               s->Bal = 0;
               r->Bal = 1;
            }
            p->Bal = 0;
            pa[k - 1]->Link[a[k - 1]] = p;
            if (*tree == s)
            {
               /* Michael Bernstein: if k == 1 we have to set new root into tree */
               *tree = p;
            }
         }
      }
      else
      {
         /* D10. */
         if (s->Bal == 1)
         {
            s->Bal = 0;
            continue;
         }
         else if (s->Bal == 0)
         {
            s->Bal = -1;
            break;
         }
         r = s->Link[0];
         if (r->Bal == 0)
         {
            /* D11. */
            s->Link[0] = r->Link[1];
            r->Link[1] = s;
            r->Bal = 1;
            pa[k - 1]->Link[a[k - 1]] = r;
            if (*tree == s)
            {
               /* Michael Bernstein: if k == 1 we have to set new root into tree */
               *tree = r;
            }
            break;
         }
         else if (r->Bal == -1)
         {
            /* D12. */
            s->Link[0] = r->Link[1];
            r->Link[1] = s;
            s->Bal = r->Bal = 0;
            pa[k - 1]->Link[a[k - 1]] = r;
            if (*tree == s)
            {
               /* Michael Bernstein: if k == 1 we have to set new root into tree */
               *tree = r;
            }
         }
         else if (r->Bal == 1)
         {
            /* D13. */
            p = r->Link[1];
            r->Link[1] = p->Link[0];
            p->Link[0] = r;
            s->Link[0] = p->Link[1];
            p->Link[1] = s;
            if (p->Bal == -1)
            {
               s->Bal = 1;
               r->Bal = 0;
            }
            else if (p->Bal == 0)
               s->Bal = r->Bal = 0;
            else
            {
               s->Bal = 0;
               r->Bal = -1;
            }
            p->Bal = 0;
            pa[k - 1]->Link[a[k - 1]] = p;
            if (*tree == s)
            {
               /* Michael Bernstein: if k == 1 we have to set new root into tree */
               *tree = p;
            }
         }
      }
   }
}

AvlKnoten AvlFind(AvlBaum tree, AvlKeyType Key)
{
#if 0
   /* rekursive Loesung */
   if (k < tree->key)
   {
      if (tree->Link[0] != NULL)
         return(AvlFind(tree->Link[0], Key));
      else
         return(NULL);
   }
   else if (k > tree->key)
   {
      if (tree->Link[1] != NULL)
         return(AvlFind(tree->Link[1], Key));
      else
         return(NULL);
   }
   else
      return(tree);
#else
   AvlKnoten PresentPtr;

   /* iterativ, schneller als rekursiv */
   PresentPtr = tree;
   while ((PresentPtr != NULL) && (PresentPtr->Key != Key))
   {
      if (Key < PresentPtr->Key)
         PresentPtr = PresentPtr->Link[0];
      else if (Key > PresentPtr->Key)
         PresentPtr = PresentPtr->Link[1];
   }
   return(PresentPtr);
#endif
}

avl.pas

(* Da der Datentyp des AVL-Baums erst bei einer konkreten *)
(* Anwendung feststeht, ist der Baum nur als Beispiel und *)
(* nicht als Modul programmiert.                          *)

const
   AvlMaxHeight = 32;

type
   AvlKeyType = long_integer;
   AvlKnoten = ^AvlElement;
   AvlElement = record
      Key : AvlKeyType;
      Bal : integer;
      cache : integer; (* Used during insertion *)
      Link : array[0..1] of AvlKnoten;
   end;
   AvlBaum = AvlKnoten;

procedure AvlCreate(var tree : AvlBaum);
begin
   tree := nil;
end;

procedure AvlInsert(var tree : AvlBaum; Key: AvlKeyType);
   (* Uses Knuth's Algorithm 6.2.3A (balanced tree search and
      insertion), but caches results of comparisons.  In empirical
      tests this eliminates about 25% of the comparisons seen under
      random insertions.  *)
var
   (* A1. *)
   t, s, p, q, r, this : AvlKnoten;
   fertig : boolean;
begin
   new(this);
   this^.Key := Key;
   this^.Bal := 0;
   if (tree = nil) then
      tree := this
   else
   begin
      t := tree;
      s := tree;
      p := tree;
      fertig := false;
      while not fertig do
      begin
         (* A2. *)
         (* compare, included in  A3, Michael Bernstein *)
         (* A3. *)
         if (key < p^.Key) then
         begin
            p^.cache := 0;
            q := p^.Link[0];
            if (q = nil) then
            begin
               p^.Link[0] := this;
               q := this;
               fertig := true;
            end;
         end
>    p^.Key) then
         begin
            p^.cache := 1;
            q := p^.Link[1];
            if (q = nil) then
            begin
               p^.Link[1] := this;
               q := this;
               fertig := true;
            end;
         end;
         if not fertig then
         begin
            (* A3, A4. *)
            if (q^.Bal <> 0) then
            begin
               t := p;
               s := q;
            end;
            p := q;
         end;
      end;
      (* A5. *)
      this^.Link[0] := nil;
      this^.Link[1] := nil;
      (* A6. *)
      r := s^.Link[s^.cache];
      p := s^.Link[s^.cache];
      while (p <> q) do
      begin
         p^.Bal := p^.cache * 2 - 1;
         p := p^.Link[p^.cache];
      end;
      (* A7. *)
      fertig := false;
      if (s^.cache = 0) then
      begin
         (* a := -1. *)
         if (s^.Bal = 0) then
         begin
            s^.Bal := -1;
            fertig := true;
         end
         else if (s^.Bal = 1) then
         begin
            s^.Bal := 0;
            fertig := true;
         end
         else if (r^.Bal = -1) then
         begin
            (* A8. *)
            p := r;
            s^.Link[0] := r^.Link[1];
            r^.Link[1] := s;
            s^.Bal := 0;
            r^.Bal := 0;
         end
         else
         begin
            (* A9. *)
            p := r^.Link[1];
            r^.Link[1] := p^.Link[0];
            p^.Link[0] := r;
            s^.Link[0] := p^.Link[1];
            p^.Link[1] := s;
            if (p^.Bal = -1) then
            begin
               s^.Bal := 1;
               r^.Bal := 0;
            end
            else if (p^.Bal = 0) then
            begin
               s^.Bal := 0;
               r^.Bal := 0;
            end
            else 
            begin
               s^.Bal := 0;
               r^.Bal := -1;
            end;
            p^.Bal := 0;
         end;
      end
      else
      begin
         (* a = +1. *)
         if (s^.Bal = 0) then
         begin
            s^.Bal := 1;
            fertig := true;
         end
         else if (s^.Bal = -1) then
         begin
            s^.Bal := 0;
            fertig := true;
         end
         else if (r^.Bal = 1) then
         begin
            (* A8. *)
            p := r;
            s^.Link[1] := r^.Link[0];
            r^.Link[0] := s;
            s^.Bal := 0;
            r^.Bal := 0;
         end
         else
         begin
            (* A9. *)
            p := r^.Link[0];
            r^.Link[0] := p^.Link[1];
            p^.Link[1] := r;
            s^.Link[1] := p^.Link[0];
            p^.Link[0] := s;
            if (p^.Bal = 1) then
            begin
               s^.Bal := -1;
               r^.Bal := 0;
            end
            else if (p^.Bal = 0) then
            begin
               s^.Bal := 0;
               r^.Bal := 0;
            end
            else 
            begin
               s^.Bal := 0;
               r^.Bal := 1;
            end;
            p^.Bal := 0;
         end;
      end;
      (* A10. *)
      if not fertig then
      begin
         (*if (t <> *tree && s = t^.Left)*)
         if (s = t^.Link[1]) then
            t^.Link[1] := p
         else if (s = t^.Link[0]) then
            t^.Link[0] := p
         else
            tree := p;
      end;
   end;
end;

procedure AvlRemove(var tree : AvlBaum; Key : AvlKeyType);
   (* Uses my Algorithm D, which can be found at
      http://www.msu.edu/user/pfaffben/avl.  Algorithm D is based on
      Knuth's Algorithm 6.2.2D (Tree deletion) and 6.2.3A (Balanced
      tree search and insertion), as well as the notes on pages 465-466
      of Vol. 3. *)
var
   (* D1. *)
   pa : array[0..AvlMaxHeight] of AvlKnoten; (* Stack P: Nodes. *)
   a : array[0..AvlMaxHeight] of integer;    (* Stack P: Bits. *)
   k : integer;                              (* Stack P: Pointer. *)
   p, q, r, s : AvlKnoten;
   l : integer;
   fertig : boolean;
begin
   (* insert dummy entry because access to k-1 is used *)
   (* and this can generate access to pa[0], but we dont *)
   (* want to modify any node in the tree *)
   a[0] := 0;
   new(pa[0]);
   pa[0]^.Key := 0;
   pa[0]^.Link[0] := nil;
   pa[0]^.Link[1] := nil;
   p := tree;
   k := 1;
   fertig := false;
   while not fertig do
   begin
      (* D2. *)
      if (p = nil) then
         fertig := true
      else if (Key = p^.Key) then
         fertig := true
      else
      begin
         (* D3, D4. *)
         pa[k] := p;
         if (Key < p^.Key) then
         begin
            p := p^.Link[0];
            a[k] := 0;
         end
         else if (Key > p^.Key) then
         begin
            p := p^.Link[1];
            a[k] := 1;
         end;
         k := k + 1;
      end;
   end;
   if p<>nil then
   begin
      (* D5. *)
      if (p^.Link[1] = nil) then
      begin
         pa[k - 1]^.Link[a[k - 1]] := p^.Link[0];
         if (pa[k - 1]^.Link[a[k - 1]] <> nil) then
            pa[k - 1]^.Link[a[k - 1]]^.Bal := 0;
      end
      else
      begin
         (* D6. *)
         r := p^.Link[1];
         if (r^.Link[0] = nil) then
         begin
            r^.Link[0] := p^.Link[0];
            q := r;
            r^.Bal := p^.Bal;
            a[k] := 1;
            pa[k] := r;
            k := k + 1;
         end
         else
         begin
            (* D7. *)
            s := r^.Link[0];
            l := k;
            k := k + 1;
            a[k] := 0;
            pa[k] := r;
            k := k + 1;
            (* D8. *)
            while (s^.Link[0] <> nil) do
            begin
               r := s;
               s := r^.Link[0];
               a[k] := 0;
               pa[k] := r;
               k := k + 1;
            end;
            (* D9. *)
            a[l] := 1;
            pa[l] := s;
            s^.Link[0] := p^.Link[0];
            r^.Link[0] := s^.Link[1];
            s^.Link[1] := p^.Link[1];
            s^.Bal := p^.Bal;
            q := s;
         end;
      end;
      if (p = tree) then
         (* Michael Bernstein: delete tree, we had to set new tree *)
         tree := q;
      (* Michael Bernstein: else tree is unchanged *)
      dispose(p);
      (* D10. *)
      k := k - 1;
      while (k > 0) do
      begin
         fertig := false;
         s := pa[k];
         if (a[k] = 0) then
         begin
            (* D10. *)
            if (s^.Bal = -1) then
            begin
               s^.Bal := 0;
               fertig := true;
            end
            else if (s^.Bal = 0) then
            begin
               s^.Bal := 1;
               fertig := true;
               k := 0; (* to nd loop *)
            end;
            if not fertig then
            begin
               r := s^.Link[1];
               if (r^.Bal = 0) then
               begin
                  (* D11. *)
                  s^.Link[1] := r^.Link[0];
                  r^.Link[0] := s;
                  r^.Bal := -1;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  if (tree = s) then
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
                  fertig := true;
                  k := 0; (* to end loop *)
               end
               else if (r^.Bal = 1) then
               begin
                  (* D12. *)
                  s^.Link[1] := r^.Link[0];
                  r^.Link[0] := s;
                  s^.Bal := 0;
                  r^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  if (tree = s) then
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
               end
               else
               begin
                  (* D13. *)
                  p := r^.Link[0];
                  r^.Link[0] := p^.Link[1];
                  p^.Link[1] := r;
                  s^.Link[1] := p^.Link[0];
                  p^.Link[0] := s;
                  if (p^.Bal = 1) then
                  begin
                     s^.Bal := -1;
                     r^.Bal := 0;
                  end
                  else if (p^.Bal = 0) then
                  begin
                     s^.Bal := 0;
                     r^.Bal := 0;
                  end
                  else
                  begin
                     s^.Bal := 0;
                     r^.Bal := 1;
                  end;
                  p^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := p;
                  if (tree = s) then
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := p;
               end;
            end;
         end
         else
         begin
            (* D10. *)
            if (s^.Bal = 1) then
            begin
               s^.Bal := 0;
               fertig := true;
            end
            else if (s^.Bal = 0) then
            begin
               s^.Bal := -1;
               fertig := true;
               k := 0; (* to end loop *)
            end;
            if not fertig then
            begin
               r := s^.Link[0];
               if (r^.Bal = 0) then
               begin
                  (* D11. *)
                  s^.Link[0] := r^.Link[1];
                  r^.Link[1] := s;
                  r^.Bal := 1;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  if (tree = s) then
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
                  fertig := true;
                  k := 0; (* to end loop *)
               end
               else if (r^.Bal = -1) then
               begin
                  (* D12. *)
                  s^.Link[0] := r^.Link[1];
                  r^.Link[1] := s;
                  s^.Bal := 0;
                  r^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  if (tree = s) then
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
               end
               else if (r^.Bal = 1) then
               begin
                  (* D13. *)
                  p := r^.Link[1];
                  r^.Link[1] := p^.Link[0];
                  p^.Link[0] := r;
                  s^.Link[0] := p^.Link[1];
                  p^.Link[1] := s;
                  if (p^.Bal = -1) then
                  begin
                     s^.Bal := 1;
                     r^.Bal := 0;
                  end
                  else if (p^.Bal = 0) then
                  begin
                     s^.Bal := 0;
                     r^.Bal := 0;
                  end
                  else
                  begin
                     s^.Bal := 0;
                     r^.Bal := -1;
                  end;
                  p^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := p;
                  if (tree = s) then
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := p;
               end;
            end;
         end;
         k := k - 1;
      end;
   end;
   dispose(pa[0]);
end;

function AvlFind(tree : AvlBaum; Key : AvlKeyType):AvlKnoten;
var
   PresentPtr : AvlKnoten;
   Found : boolean;
begin
   (* iterativ, schneller als rekursiv *)
   PresentPtr := tree;
   Found := false;
   while not Found do
   begin
      if (PresentPtr = nil) then
         Found := true
      else if (PresentPtr^.Key = Key) then
         Found := true
      else if (Key < PresentPtr^.Key) then
         PresentPtr := PresentPtr^.Link[0]
      else if (Key > PresentPtr^.Key) then
         PresentPtr := PresentPtr^.Link[1];
   end;
   AvlFind := PresentPtr;
end;

avl.mod

(* Da der Datentyp des AVL-Baums erst bei einer konkreten *)
(* Anwendung feststeht, ist der Baum nur als Beispiel und *)
(* nicht als Modul programmiert.                          *)

FROM Heap IMPORT Allocate, Deallocate;
FROM SYSTEM IMPORT TSIZE;

CONST
   AvlMaxHeight = 32;

TYPE
   AvlKeyType = LONGINT;
   AvlKnoten = POINTER TO AvlElement;
   AvlElement = RECORD
      Key : AvlKeyType;
      Bal : INTEGER;
      cache : INTEGER; (* Used during insertion *)
      Link : ARRAY[0..1] OF AvlKnoten;
   END;
   AvlBaum = AvlKnoten;

PROCEDURE AvlCreate(VAR tree : AvlBaum);
BEGIN
   tree := NIL;
END AvlCreate;

PROCEDURE AvlInsert(VAR tree : AvlBaum; Key: AvlKeyType);
   (* Uses Knuth's Algorithm 6.2.3A (balanced tree search and
      insertion), but caches results of comparisons.  In empirical
      tests this eliminates about 25% of the comparisons seen under
      random insertions.  *)
VAR
   (* A1. *)
   t, s, p, q, r, this : AvlKnoten;
   fertig : BOOLEAN;
BEGIN
   Allocate(this,TSIZE(AvlElement));
   this^.Key := Key;
   this^.Bal := 0;
   IF (tree = NIL) THEN
      tree := this;
   ELSE
      t := tree;
      s := tree;
      p := tree;
      fertig := FALSE;
      WHILE NOT fertig DO
         (* A2. *)
         (* compare, included in  A3, Michael Bernstein *)
         (* A3. *)
         IF (Key < p^.Key) THEN
            p^.cache := 0;
            q := p^.Link[0];
            IF (q = NIL) THEN
               p^.Link[0] := this;
               q := this;
               fertig := TRUE;
            END;
         (* A4. *)
         ELSIF (Key > p^.Key) THEN
            p^.cache := 1;
            q := p^.Link[1];
            IF (q = NIL) THEN
               p^.Link[1] := this;
               q := this;
               fertig := TRUE;
            END;
         END;
         IF NOT fertig THEN
            (* A3, A4. *)
            IF (q^.Bal <> 0) THEN
               t := p;
               s := q;
            END;
            p := q;
         END;
      END;
      (* A5. *)
      this^.Link[0] := NIL;
      this^.Link[1] := NIL;
      (* A6. *)
      r := s^.Link[s^.cache];
      p := s^.Link[s^.cache];
      WHILE (p <> q) DO
         p^.Bal := p^.cache * 2 - 1;
         p := p^.Link[p^.cache];
      END;
      (* A7. *)
      fertig := FALSE;
      IF (s^.cache = 0) THEN
         (* a := -1. *)
         IF (s^.Bal = 0) THEN
            s^.Bal := -1;
            fertig := TRUE;
         ELSIF (s^.Bal = 1) THEN
            s^.Bal := 0;
            fertig := TRUE;
         ELSIF (r^.Bal = -1) THEN
            (* A8. *)
            p := r;
            s^.Link[0] := r^.Link[1];
            r^.Link[1] := s;
            s^.Bal := 0;
            r^.Bal := 0;
         ELSE
            (* A9. *)
            p := r^.Link[1];
            r^.Link[1] := p^.Link[0];
            p^.Link[0] := r;
            s^.Link[0] := p^.Link[1];
            p^.Link[1] := s;
            IF (p^.Bal = -1) THEN
               s^.Bal := 1;
               r^.Bal := 0;
            ELSIF (p^.Bal = 0) THEN
               s^.Bal := 0;
               r^.Bal := 0;
            ELSE
               s^.Bal := 0;
               r^.Bal := -1;
            END;
            p^.Bal := 0;
         END;
      ELSE
         (* a = +1. *)
         IF (s^.Bal = 0) THEN
            s^.Bal := 1;
            fertig := TRUE;
         ELSIF (s^.Bal = -1) THEN
            s^.Bal := 0;
            fertig := TRUE;
         ELSIF (r^.Bal = 1) THEN
            (* A8. *)
            p := r;
            s^.Link[1] := r^.Link[0];
            r^.Link[0] := s;
            s^.Bal := 0;
            r^.Bal := 0;
         ELSE
            (* A9. *)
            p := r^.Link[0];
            r^.Link[0] := p^.Link[1];
            p^.Link[1] := r;
            s^.Link[1] := p^.Link[0];
            p^.Link[0] := s;
            IF (p^.Bal = 1) THEN
               s^.Bal := -1;
               r^.Bal := 0;
            ELSIF (p^.Bal = 0) THEN
               s^.Bal := 0;
               r^.Bal := 0;
            ELSE
               s^.Bal := 0;
               r^.Bal := 1;
            END;
            p^.Bal := 0;
         END;
      END;
      (* A10. *)
      IF NOT fertig THEN
         (*if (t <> *tree && s = t^.Left)*)
         IF (s = t^.Link[1]) THEN
            t^.Link[1] := p;
         ELSIF (s = t^.Link[0]) THEN
            t^.Link[0] := p;
         ELSE
            tree := p;
         END;
      END;
   END;
END AvlInsert;

PROCEDURE AvlRemove(VAR tree : AvlBaum; Key : AvlKeyType);
   (* Uses my Algorithm D, which can be found at
      http://www.msu.edu/user/pfaffben/avl.  Algorithm D is based on
      Knuth's Algorithm 6.2.2D (Tree deletion) and 6.2.3A (Balanced
      tree search and insertion), as well as the notes on pages 465-466
      of Vol. 3. *)
VAR
   (* D1. *)
   pa : ARRAY[0..AvlMaxHeight] OF AvlKnoten; (* Stack P: Nodes. *)
   a : ARRAY[0..AvlMaxHeight] OF INTEGER;    (* Stack P: Bits. *)
   k : INTEGER;                              (* Stack P: Pointer. *)
   p, q, r, s : AvlKnoten;
   l : INTEGER;
   fertig : BOOLEAN;
BEGIN
   (* insert dummy entry because access to k-1 is used *)
   (* and this can generate access to pa[0], but we dont *)
   (* want to modify any node in the tree *)
   a[0] := 0;
   Allocate(pa[0],TSIZE(AvlElement));
   pa[0]^.Key := 0;
   pa[0]^.Link[0] := NIL;
   pa[0]^.Link[1] := NIL;
   p := tree;
   k := 1;
   fertig := FALSE;
   WHILE NOT fertig DO
      (* D2. *)
      IF (p = NIL) THEN
         fertig := TRUE;
      ELSIF (Key = p^.Key) THEN
         fertig := TRUE;
      ELSE
         (* D3, D4. *)
         pa[k] := p;
         IF (Key < p^.Key) THEN
            p := p^.Link[0];
            a[k] := 0;
         ELSIF (Key > p^.Key) THEN
            p := p^.Link[1];
            a[k] := 1;
         END;
         k := k + 1;
      END;
   END;
   IF p <> NIL THEN
      (* D5. *)
      IF (p^.Link[1] = NIL) THEN
         pa[k - 1]^.Link[a[k - 1]] := p^.Link[0];
         IF (pa[k - 1]^.Link[a[k - 1]] <> NIL) THEN
            pa[k - 1]^.Link[a[k - 1]]^.Bal := 0;
         END;
      ELSE
         (* D6. *)
         r := p^.Link[1];
         IF (r^.Link[0] = NIL) THEN
            r^.Link[0] := p^.Link[0];
            q := r;
            r^.Bal := p^.Bal;
            a[k] := 1;
            pa[k] := r;
            k := k + 1;
         ELSE
            (* D7. *)
            s := r^.Link[0];
            l := k;
            k := k + 1;
            a[k] := 0;
            pa[k] := r;
            k := k + 1;
            (* D8. *)
            WHILE (s^.Link[0] <> NIL) DO
               r := s;
               s := r^.Link[0];
               a[k] := 0;
               pa[k] := r;
               k := k + 1;
            END;
            (* D9. *)
            a[l] := 1;
            pa[l] := s;
            s^.Link[0] := p^.Link[0];
            r^.Link[0] := s^.Link[1];
            s^.Link[1] := p^.Link[1];
            s^.Bal := p^.Bal;
            q := s;
         END;
      END;
      IF (p = tree) THEN
         (* Michael Bernstein: delete tree, we had to set new tree *)
         tree := q;
      END;
      (* Michael Bernstein: else tree is unchanged *)
      Deallocate(p,TSIZE(AvlElement));
      (* D10. *)
      k := k - 1;
      WHILE (k > 0) DO
         fertig := FALSE;
         s := pa[k];
         IF (a[k] = 0) THEN
            (* D10. *)
            IF (s^.Bal = -1) THEN
               s^.Bal := 0;
               fertig := TRUE;
            ELSIF (s^.Bal = 0) THEN
               s^.Bal := 1;
               fertig := TRUE;
               k := 0; (* to end loop *)
            END;
            IF NOT fertig THEN
               r := s^.Link[1];
               IF (r^.Bal = 0) THEN
                  (* D11. *)
                  s^.Link[1] := r^.Link[0];
                  r^.Link[0] := s;
                  r^.Bal := -1;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  IF (tree = s) THEN
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
                  END;
                  fertig := TRUE;
                  k := 0; (* to end loop *)
               ELSIF (r^.Bal = 1) THEN
                  (* D12. *)
                  s^.Link[1] := r^.Link[0];
                  r^.Link[0] := s;
                  s^.Bal := 0;
                  r^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  IF (tree = s) THEN
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
                  END;
               ELSE
                  (* D13. *)
                  p := r^.Link[0];
                  r^.Link[0] := p^.Link[1];
                  p^.Link[1] := r;
                  s^.Link[1] := p^.Link[0];
                  p^.Link[0] := s;
                  IF (p^.Bal = 1) THEN
                     s^.Bal := -1;
                     r^.Bal := 0;
                  ELSIF (p^.Bal = 0) THEN
                     s^.Bal := 0;
                     r^.Bal := 0;
                  ELSE
                     s^.Bal := 0;
                     r^.Bal := 1;
                  END;
                  p^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := p;
                  IF (tree = s) THEN
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := p;
                  END;
               END;
            END;
         ELSE
            (* D10. *)
            IF (s^.Bal = 1) THEN
               s^.Bal := 0;
               fertig := TRUE;
            ELSIF (s^.Bal = 0) THEN
               s^.Bal := -1;
               fertig := TRUE;
               k := 0; (* to end loop *)
            END;
            IF NOT fertig THEN
               r := s^.Link[0];
               IF (r^.Bal = 0) THEN
                  (* D11. *)
                  s^.Link[0] := r^.Link[1];
                  r^.Link[1] := s;
                  r^.Bal := 1;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  IF (tree = s) THEN
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
                  END;
                  fertig := TRUE;
                  k := 0; (* to end loop *)
               ELSIF (r^.Bal = -1) THEN
                  (* D12. *)
                  s^.Link[0] := r^.Link[1];
                  r^.Link[1] := s;
                  s^.Bal := 0;
                  r^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := r;
                  IF (tree = s) THEN
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := r;
                  END;
               ELSIF (r^.Bal = 1) THEN
                  (* D13. *)
                  p := r^.Link[1];
                  r^.Link[1] := p^.Link[0];
                  p^.Link[0] := r;
                  s^.Link[0] := p^.Link[1];
                  p^.Link[1] := s;
                  IF (p^.Bal = -1) THEN
                     s^.Bal := 1;
                     r^.Bal := 0;
                  ELSIF (p^.Bal = 0) THEN
                     s^.Bal := 0;
                     r^.Bal := 0;
                  ELSE
                     s^.Bal := 0;
                     r^.Bal := -1;
                  END;
                  p^.Bal := 0;
                  pa[k - 1]^.Link[a[k - 1]] := p;
                  IF (tree = s) THEN
                     (* Michael Bernstein: if k = 1 we have to set new root into tree *)
                     tree := p;
                  END;
               END;
            END;
         END;
         k := k - 1;
      END;
   END;
   Deallocate(pa[0],TSIZE(AvlElement));
END AvlRemove;

PROCEDURE AvlFind(tree : AvlBaum; Key : AvlKeyType) : AvlKnoten;
VAR
   PresentPtr : AvlKnoten;
   Found : BOOLEAN;
BEGIN
   (* iterativ, schneller als rekursiv *)
   PresentPtr := tree;
   Found := FALSE;
   WHILE NOT Found DO
      IF (PresentPtr = NIL) THEN
         Found := TRUE;
      ELSIF (PresentPtr^.Key = Key) THEN
         Found := TRUE;
      ELSIF (Key < PresentPtr^.Key) THEN
         PresentPtr := PresentPtr^.Link[0]
      ELSIF (Key > PresentPtr^.Key) THEN
         PresentPtr := PresentPtr^.Link[1];
      END;
   END;
   RETURN PresentPtr;
END AvlFind;

English version not yet available.