From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,510b4cdcdad0ea32
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2001-04-18 19:54:13 PST
Path: 
 supernews.google.com!newsfeed.google.com!newsfeed.stanford.edu!nntp.cs.ubc.ca!nntp-relay.ihug.net!newsfeeds.ihug.co.nz!ihug.co.nz!nsw.nnrp.telstra.net!dnews.tpgi.com.au!tpg.com.au
Message-ID: <3ADE5325.B28ADFE2@tpg.com.au>
From: Frank Ranner <franner@tpg.com.au>
X-Mailer: Mozilla 4.76 [en] (X11; U; Linux 2.2.14-5.0smp i686)
X-Accept-Language: en
MIME-Version: 1.0
Newsgroups: comp.lang.ada
Subject: Re: AVL and red-black trees
References: <9bhfmo$93v60$1@ID-78807.news.dfncis.de>
 <3ADCE649.C02947B5@earthlink.net> <9bjhl4$n6t$1@news.huji.ac.il>
 <9bk5qe$9mf5l$1@ID-78807.news.dfncis.de>
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Original-NNTP-Posting-Host: 203.12.167.241
X-Original-Trace: 19 Apr 2001 13:25:08 +1000, 203.12.167.241
Date: Thu, 19 Apr 2001 12:53:25 +1000
NNTP-Posting-Host: 203.12.160.33
X-Complaints-To: abuse@telstra.net
X-Trace: nsw.nnrp.telstra.net 987648849 203.12.160.33 (Thu,
 19 Apr 2001 12:54:09 EST)
NNTP-Posting-Date: Thu, 19 Apr 2001 12:54:09 EST
Organization: Customer of Telstra Big Pond Direct
Xref: supernews.google.com comp.lang.ada:6990
Date: 2001-04-19T12:53:25+10:00
List-Id: <comp.lang.ada>

Roberto wrote:
> 
> I must search 2 implementations (better in Ada to not translate) and make a
> lot of tests (insert, delete and search) with them.
> 
> The problem is that I haven't found an implementation with the remove
> operation (and the explanations that I've found in Internet aren't clear).
> 
> --
> 
> Greetings
> 
> Roberto
Here are the sample implementations that were provided by my uni. you
will need to
split them up and get them working.

AVL
==============================

with text_io; use text_io;

procedure avl is

type balance is (left_heavy, balanced, right_heavy);

type node;

type ptr_to_node is access node;

type node is record
               data        : integer;
               count       : positive    := 1;
               left, right : ptr_to_node := null;
               bal         : balance     := balanced;
             end record;

root : ptr_to_node := null;

hh : boolean := false;

procedure print (p : ptr_to_node; n : integer) is

  i : integer;

begin

  if p /= null then
    print (p.right, n+4);
    for i in 1 .. n loop
      put(' ');
    end loop;
    put(integer'image(p.data));
    new_line;
    print (p.left, n+4);
  end if;

end print;

procedure insert (x : integer; p : in out ptr_to_node; h : in out
boolean) is

  p1, p2 : ptr_to_node;

begin


  if p = null then

    -- word is not in tree : insert it
    p := new node;
    p.data := x;
    h := true;

  elsif x < p.data then

    insert (x, p.left, h);

    if h then

      case p.bal is

        when right_heavy => p.bal := balanced;
                            h := false;

        when balanced    => p.bal := left_heavy;

        when left_heavy  => p1 := p.left;

                            if p1.bal = left_heavy then

                              -- single LL rotation
                              p.left := p1.right;
                              p1.right := p;
                              p.bal := balanced;
                              p := p1;

                            else

                              -- double LR rotation
                              p2 := p1.right;
                              p1.right := p2.left;
                              p2.left := p1;
                              p.left := p2.right;
                              p2.right := p;

                              if p2.bal = left_heavy then
                                p.bal := right_heavy;
                              else
                                p.bal := balanced;
                              end if;

                              if p2.bal = right_heavy then
                                p1.bal := left_heavy;
                              else
                                p1.bal := balanced;
                              end if;

                            end if;

                            p.bal := balanced;
                            h := false;

      end case;

    end if;

  elsif x > p.data then

    insert (x, p.right, h);

    if h then

      case p.bal is

        when left_heavy  => p.bal := balanced;
                            h := false;

        when balanced    => p.bal := right_heavy;

        when right_heavy => -- rebalance
                            p1 := p.right;

                            if p.bal = right_heavy then

                              -- single RR rotation
                              p.right := p1.left;
                              p1.left := p;
                              p.bal := balanced;
                              p := p1;

                            else

                              -- double RL rotation
                              p2 := p1.left;
                              p1.left := p2.right;
                              p2.right := p1;
                              p.right := p2.left;
                              p2.left := p;

                              if p2.bal = right_heavy then
                                p.bal := left_heavy;
                              else
                                p.bal := balanced;
                              end if;

                              if p2.bal = left_heavy then
                                p1.bal := right_heavy;
                              else
                                p1.bal := balanced;
                              end if;

                            end if;

                            p.bal := balanced;
                            h := false;

      end case;

    end if;

  else

    p.count := p.count + 1;
    h := false;

  end if;

end;





procedure delete (x : integer; p : in out ptr_to_node; h : in out
boolean) is

  q : ptr_to_node;

  procedure balance_1 (p : in out ptr_to_node; h : in out boolean) is

    p1, p2 : ptr_to_node;
    b1, b2 : balance;
  begin
    -- h = true, left branch has become less high
    case p.bal is
      when left_heavy  => p.bal := balanced;
      when balanced    => p.bal := right_heavy;
                          h := false;
      when right_heavy => -- rebalance
                          p1 := p.right;
                          b1 := p1.bal;
                          if b1 >= balanced then
                            -- single RR rotation
                            p.right := p1.left;
                            p1.left := p;
                            if b1 = balanced then
                              p.bal := right_heavy;
                              p1.bal := left_heavy;
                              h := false;
                            else
                              p.bal := balanced;
                              p1.bal := balanced;
                            end if;
                            p := p1;
                          else
                            -- double RL rotation
                            p2 := p1.left;
                            b2 := p2.bal;
                            p1.left := p2.right;
                            p2.right := p1;
                            p.right := p2.left;
                            p2.left := p;
                            if b2 = right_heavy then
                              p.bal := left_heavy;
                            else
                              p.bal := balanced;
                            end if;
                            if b2 = left_heavy then
                              p1.bal := right_heavy;
                            else
                              p1.bal := balanced;
                            end if;
                            p := p2;
                            p2.bal := balanced;
                          end if;
    end case;
  end;






  procedure balance_2 (p : in out ptr_to_node; h : in out boolean) is

    p1, p2 : ptr_to_node;
    b1, b2 : balance;

  begin
    case p.bal is
      when right_heavy => p.bal := balanced;
      when balanced    => p.bal := left_heavy;
                          h := false;
      when left_heavy  => -- rebalance
                          p1 := p.left;
                          b1 := p1.bal;
                          if b1 <= balanced then
                            -- single LL rotation
                            p.left := p1.right;
                            p1.right := p;
                            if b1 = balanced then
                              p.bal := left_heavy;
                              p1.bal := right_heavy;
                              h := false;
                            else
                              p.bal := balanced;
                              p1.bal := balanced;
                            end if;
                            p := p1;
                          else
                            -- double LR rotation
                            p2 := p1.right;
                            b2 := p2.bal;
                            p1.right := p2.left;
                            p2.left := p1;
                            p.left := p2.right;
                            p2.right := p;
                            if b2 = left_heavy then
                              p.bal := right_heavy;
                            else
                              p.bal := balanced;
                            end if;
                            if b2 = right_heavy then
                              p1.bal := left_heavy;
                            else
                              p1.bal := balanced;
                            end if;
                            p := p2;
                            p2.bal := balanced;
                          end if;
    end case;
  end balance_2;


  procedure del (r : in out ptr_to_node; h : in out boolean) is
  begin
    -- h = false
    if r.right /= null then
      del (r.right, h);
      if h then
        balance_2(r, h);
      end if;
    else
      q.data := r.data;
      q.count := r.count;
      r := r.left;
      h := true;
    end if;
  end;


begin -- delete
  if p = null then
    --put_line("data is not in tree");
    h := false;
  elsif x < p.data then
    delete (x, p.left, h);
    if h then
      balance_1 (p, h);
    end if;
  elsif x > p.data then
    delete (x, p.right, h);
    if h then
      balance_2 (p, h);
    end if;
  else
    -- delete p
    q := p;
    if q.right = null then
      p := q.left;
      h := true;
    elsif q.left = null then
      p := q.right;
      h := true;
    else
      del (q.left, h);
      if h then
        balance_1 (p, h);
      end if;
    end if;
    -- dispose(q);
  end if;
end delete;






begin

  for i in 1 .. 31 loop
    insert (i, root, hh);
  end loop;

  print(root, 1);

  for i in 10 .. 20 loop
    delete (i, root, hh);
  end loop;

  print(root, 1);


end;

=================================
Red-black
=================================
with tree_dec; use tree_dec;
with ansi; use ansi;

package rb_tree is

   x:integer:=0;


   procedure Initialize (t: in out tree);

   procedure  insert     (x: tree; e: item);
   procedure delete     (t: in out tree; e: item; successful: out
boolean);
   function  locate     (t: tree; e: item) return tree;

   procedure printin    (t: tree; indent:natural:=1);

   function  nodes      (t: tree) return natural;
--   function  leaves     (t: tree) return natural;
--   function  not_leaves (t: tree) return natural;
--   function  height     (t: tree) return natural;
   function  Empty      (t: tree) return boolean;

end rb_tree;



with text_io;

package body rb_tree is

   z:tree;
   head:tree;
   toggle:boolean;

   package item_io is new text_io.integer_io(item); use item_io;

   procedure Initialize (t: in out tree) is
   begin
      z:=new node;
      z.red:=false;
      head:=new node;
      head.data:=item'first;
      head.right:=z;
      head.left:=z;
      head.red:=false;
      z.data:=item'last;
      t:=head;
   end initialize;








   procedure insert (x: tree; e: item) is
      xx:tree:=x;
      gg,g,f,temp:tree;
      function split(v:item; gg,g,f,x:tree) return tree is
         tgg:tree:=gg;
         tg:tree:=g;
         tf:tree:=f;
         tx:tree:=x;
         function rotate(v:item;y:tree) return tree is
            s,gs:tree;
         begin
            if v<y.data then
               s:=y.left;
            else
               s:=y.right;
            end if;
            if v<s.data then
               gs:=s.left;
               s.left:=gs.right;
               gs.right:=s;
            else
               gs:=s.right;
               s.right:=gs.left;
               gs.left:=s;
            end if;
            if v<y.data then
               y.left:=gs;
            else
               y.right:=gs;
            end if;
            return (gs);
         end rotate;
      begin
         tx.red:=true;
         tx.left.red:=false;
         tx.right.red:=false;
         if tf.red then
            tg.red:=true;
            if (v<tg.data)/=(v<tf.data) then
               tf:=rotate(v,tg);
            end if;
            tx:=rotate(v,tgg);
            tx.red:=false;
         end if;
         head.right.red:=false;     -- set head to red.
         return tx;
      end split;
   begin
      f:=xx;
      g:=xx;



      loop
         gg:=g;
         g:=f;
         f:=xx;
         if e<xx.data then
            xx:=xx.left;
         else
            xx:=xx.right;
         end if;
      exit when xx=z;

         if xx.left.red and xx.right.red then
            xx:=split(e,gg,g,f,xx);
         end if;
      end loop;
      xx:=new node;
      xx.data:=e;
      xx.left:=z;
      xx.right:=z;
      if e<f.data then
         f.left:=xx;
      else
         f.right:=xx;
      end if;
      temp:=xx;
      xx:=split(e,gg,g,f,xx);
--      z.red:=true;
--      return temp;
   end insert;

   procedure printin(t:tree; indent: natural:=1) is
      cost,i:natural:=indent;
   begin
      if (t/=z) then
         if t.red then
            cost:=cost-1;
         end if;
         printin(t.left,cost+1);
         for i in 1..cost*item'width loop
            put(" ");
         end loop;

         if (t.left.red)and(t.right.red) then
            text(foreground=>lightblue);
         elsif (t.left.red)or(t.right.red) then
            text(foreground=>lightgreen);
         elsif t.red then
            text(foreground=>lightred);
         else
            text(foreground=>white);
         end if;
         put(t.data);
         new_line;
         x:=x+1;
         printin(t.right,cost+1);
      end if;
   end printin;





   procedure delete (t: in out tree; e: item; successful: out boolean)
is
      q:tree;
      procedure crossoutl(r: in out tree) is
      begin
         if r.left/=z then
            crossoutl(r.left);
         else
            q.data:=r.data;
            q:=r;
            r:=r.right;
         end if;
      end crossoutl;
      procedure crossoutr(r: in out tree) is
      begin
         if r.right/=z then
            crossoutr(r.right);
         else
            q.data:=r.data;
            q:=r;
            r:=r.left;
         end if;
      end crossoutr;
   begin
      successful:=true;
      if t=z then
         successful:=false;
      elsif e<t.data then
         delete(t.left,e,successful);
      elsif e>t.data then
         delete(t.right,e,successful);
      else
         q:=t;
         if q.right=z then
            t:=q.left;
         elsif q.left=z then
            t:=q.right;
         else
            if q.right.red=q.left.red then
               if toggle then
                  crossoutl(q.right);
                  toggle:=false;
               else
                  crossoutr(q.left);
                  toggle:=true;
               end if;
            elsif q.left.red then
               crossoutr(q.left);
            elsif q.right.red then
               crossoutl(q.right);
            end if;
         end if;
      end if;
   end delete;

   function nodes(t:tree) return natural is
   begin
      if t=z then
         return 0;
      else
         return 1+nodes(t.left)+nodes(t.right);
      end if;
   end nodes;



   function locate (t: tree; e: item) return tree is
      found:boolean:=false;
      p:tree:=t;
   begin
      while (p/=null) and (not found) loop
         if p.data=e then
            found:=true;
         elsif e<t.data then
            p:=p.left;
         else
            p:=p.right;
         end if;
      end loop;
      return p;
   end locate;

   function not_leaves(t:tree) return natural is
   begin
      if empty(t) then
         return 0;
      elsif (t.left=null)and(t.right=null) then
         return 0;
      else
         return 1+not_leaves(t.left)+not_leaves(t.right);
      end if;
   end not_leaves;


   function leaves(t:tree) return natural is
   begin
      if empty(t) then
         return 0;
      elsif (t.left=null)and(t.right=null) then
         return 1;
--      else
--         return leaves(t.left)+nodes(t.right);
      end if;
   end leaves;

   function height(t:tree) return natural is
      function max(a,b:natural) return natural is
      begin
         if a>b then
            return a;
         else
            return b;
         end if;
      end max;
   begin
      if empty(t) then
         return 0;
      elsif (t.left=null)and(t.right=null) then
         return 1;
      else
         return 1+max(height(t.left),height(t.right));
      end if;
   end height;

   function Empty (t: tree) return boolean is
   begin
      return t=null;
   end;

end rb_tree;

===============================
treedec
===============================
package Tree_Dec is -- declarations for any list, queue or stack.

   type item is new integer;

   type node;

   type tree is access node;

   type node is
      record
         data : item:=item'first;
         left : tree:=null;
         right: tree:=null;
         red  : boolean:=false; -- this is for bed/black trees only,
binary
                                -- trees will just ignore it.
      end record;

   procedure put_item(e:item);
   procedure get_item(e:out item);

end Tree_Dec;




with text_io;

package body Tree_Dec is


   procedure put_item(e:item) is -- a procedure to write an element to
the
                                 -- screen.
   begin
      text_io.put(item'image(e));
      text_io.new_line;
   end put_item;


   procedure get_item(e:out item) is -- a procedure to read an element
from
                                     -- the keyboard.
      temp:string(1..80):=(others=>' ');
      len:integer;
   begin
      text_io.get_line(temp,len);
      e:=item(integer'value(temp(1..len)));
   end get_item;


end Tree_Dec;

========================
A crappy ansi package
========================
with text_io; use text_io;

package ansi is

   -- parameter if no change takes place.
   no_change  : constant natural:=natural'last;


   -- Attributes for procedure text.
   reset      : constant natural:=0;
   underscore : constant natural:=1;
   blink      : constant natural:=2;
   inverse    : constant natural:=4;
   concealed  : constant natural:=8;

   -- Colours for procedure text.
   -- (the colours are foreground colours,
   --  10 is added by the procedure
   --  for background colours and
   --  1xx is the bold version of xx)
   black        : constant natural:=30;
   darkgrey     : constant natural:=130;
   darkred      : constant natural:=31;
   lightred     : constant natural:=131;
   darkgreen    : constant natural:=32;
   lightgreen   : constant natural:=132;
   brown        : constant natural:=33;
   yellow       : constant natural:=133;
   darkblue     : constant natural:=34;
   lightblue    : constant natural:=134;
   darkmagenta  : constant natural:=35;
   lightmagenta : constant natural:=135;
   darkcyan     : constant natural:=36;
   lightcyan    : constant natural:=136;
   lightgrey    : constant natural:=37;
   white        : constant natural:=137;

   type screen is
      record
         attrib:natural:=reset;
         back_col:natural:=black;
         fore_col:natural:=lightgrey;
      end record;



   procedure put(c:character) renames text_io.put; -- so you don't have
to
   procedure put(s:string)    renames text_io.put; -- always with/use
text_io.
   procedure put_line(s:string)    renames text_io.put_line;
   procedure new_line(spacing:positive_count:=1) renames
text_io.new_line;

   procedure home;
   procedure clrscr;
   procedure clreol;


   procedure gotoxy(x,y:natural:=0);


   procedure cursor_left(x:natural);
   procedure cursor_right(x:natural);
   procedure cursor_up(y:natural);
   procedure cursor_down(y:natural);

   procedure relxy(x,y:integer:=0);


   procedure text(attribute:natural:=no_change;
                  foreground:natural:=no_change;
                  background:natural:=no_change);

   procedure beep;

end ansi;


package body ansi is

   esc : constant string:=(ascii.esc,'[');
--   esc : constant string:=("esc[");  -- for testing purposes.
   mem : screen;


   procedure home is
   begin
      put(esc & ";H");
   end home;

   procedure clrscr is
   begin
      put(esc & "2J");
   end clrscr;

   procedure clreol is
   begin
      put(esc & 'K');
   end clreol;

   function convert(x:natural) return string is
      -- a proc to convert from natural to string without leading blank.
      s:string(1..natural'image(x)'length):=natural'image(x);
   begin
      return s(2..s'last);
   end convert;

   procedure gotoxy (x,y:natural:=0) is
   begin
      put(esc & convert(y) & ';' & convert(x) & 'H');
   end gotoxy;

   procedure cursor_left(x:natural) is
   begin
      put(esc & convert(x) & 'D');
   end cursor_left;

   procedure cursor_right(x:natural) is
   begin
      put(esc & convert(x) & 'C');
   end cursor_right;

   procedure cursor_up(y:natural) is
   begin
      put(esc & convert(y) & 'A');
   end cursor_up;

   procedure cursor_down(y:natural) is
   begin
      put(esc & convert(y) & 'B');
   end cursor_down;

   procedure relxy (x,y:integer:=0) is
   begin
      if x<0 then
         cursor_left(-x);
      elsif x>0 then
         cursor_right(x);
      end if;
      if y<0 then
         cursor_up(-y);
      elsif y>0 then
         cursor_down(y);
      end if;
   end relxy;

   procedure text(attribute:natural:=no_change;
                  foreground:natural:=no_change;
                  background:natural:=no_change) is
      i:natural:=8;
   begin
      if foreground/=no_change then
         mem.attrib:=attribute;
      end if;
      if mem.attrib=reset then
         mem.attrib:=no_change;
         put(esc&"0m");
      end if;
      if foreground/=no_change then
         mem.fore_col:=foreground;
      end if;
      if background/=no_change then
         mem.back_col:=background;
      end if;

      put(esc&"0m"); -- reset for starters.

      if mem.fore_col>100 then
         put(esc&"1;"&convert(mem.fore_col-100)&"m");
      else
         put(esc&convert(mem.fore_col)&"m");
      end if;

      put(esc&"0m");

      if mem.back_col>100 then
         put(esc&convert(mem.back_col-90)&"m");
      else
         put(esc&convert(mem.back_col+10)&"m");
      end if;

      put(esc&"0m");

      while i>0 loop
         if mem.attrib>=i then
            if i=concealed  then put(esc&"8m"); end if;
            if i=inverse    then put(esc&"7m"); end if;
            if i=blink      then put(esc&"5m"); end if;
            if i=underscore then put(esc&"4m"); end if;
            -- bold is not required due to colouring.
            mem.attrib:=mem.attrib-i;
         end if;
         i:=i/2;
      end loop;
   end;

   procedure beep is
   begin
      put(ascii.bel);
   end beep;

end ansi;


=====================
Hope this helps.
regards, Frank Ranner