* Re: AVL and red-black trees
2001-04-18 13:41 ` Roberto
@ 2001-04-19 2:53 ` Frank Ranner
0 siblings, 0 replies; 5+ messages in thread
From: Frank Ranner @ 2001-04-19 2:53 UTC (permalink / raw)
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
^ permalink raw reply [flat|nested] 5+ messages in thread