redblacktree.pas
Bài toán
Cài đặt cây đỏ đen.
Độ phức tạp
chèn : O(logn)
xóa : O(logn)
tìm kiếm : O(logn)
bộ nhớ : O(n)
Code này của Bùi Đức Thiện và Nguyễn Tiến Trung Kiên
{$mode objfpc}
{$coperators on}
type TColor = (RED, BLACK);
PNode = ^TNode;
TNode = record
left, right, parent : PNode;
key : integer;
color : TColor;
end;
var sentinel : TNode;
{$macro on}
{$define NULL := @sentinel}
{$define ll := ^.left}
{$define rr := ^.right}
{$define pp := ^.parent}
{$define c := ^.color}
{$define k := ^.key}
var root : PNode = NULL;
procedure llRotate(x : PNode);
var y : PNode;
begin
if x rr=NULL then exit;
y := x rr;
x rr := y ll;
if y ll <> NULL then y ll pp := x;
y pp := x pp;
if x<>root then
if x=x pp ll
then x pp ll := y
else x pp rr := y
else root := y;
y ll := x;
x pp := y;
end;
procedure rrRotate(x : PNode);
var y : PNode;
begin
if x ll=NULL then exit;
y := x ll;
x ll := y rr;
if y rr <> NULL then y rr pp := x;
y pp := x pp;
if x<>root then
if x=x pp rr
then x pp rr := y
else x pp ll := y
else root := y;
y rr := x;
x pp := y;
end;
procedure fixInsert(x : PNode);
var y : PNode;
begin
while (x<>root) and (x pp c=RED) do
begin
if x pp = x pp pp ll then
begin
y := x pp pp rr;
if y^.color = RED
then begin
x pp c := BLACK;
y c := BLACK;
x pp pp c := RED;
x := x pp pp;
end
else begin
if x = x pp rr then
begin
x := x pp;
llRotate(x);
end;
x pp c := BLACK;
x pp pp c := RED;
rrRotate(x pp pp);
end;
end
else begin
y := x pp pp ll;
if y^.color = RED then begin
x pp c := BLACK;
y c := BLACK;
x pp pp c := RED;
x := x pp pp;
end
else begin
if x = x pp ll then
begin
x := x pp;
rrRotate(x);
end;
x pp c := BLACK;
x pp pp c := RED;
llRotate(x pp pp);
end;
end;
end;
root c := BLACK;
end;
procedure insert(key : integer);
var parent, current, x : PNode;
begin
if root=NULL then begin
new(root);
root ll := NULL;
root rr := NULL;
root pp := nil;
root c := BLACK;
root k := key;
exit;
end;
parent := nil;
current := root;
while current <> NULL do
begin
if key = current k then exit;
parent := current;
if key > current k
then current := current rr
else current := current ll;
end;
new(x);
x pp := parent;
x ll := NULL;
x rr := NULL;
x c := RED;
x k := key;
if key > parent k
then parent rr := x
else parent ll := x;
fixInsert(x);
end;
procedure fixErase(x : PNode);
var y,w : PNode;
begin
while (x <> root) and (x c = BLACK) do
begin
if x=x pp ll then begin
w := x pp rr;
if(w c= RED) then
begin
w c := BLACK;
x pp c := RED;
llRotate(x pp);
w := x pp rr;
end;
if (w ll c = BLACK) and (w rr c = BLACK) then
begin
w c := RED;
x := x pp;
end
else begin
if w rr c = BLACK then begin
w ll c :=BLACK;
w c :=RED;
rrRotate(w);
w := x pp rr;
end;
w c := x pp c;
x pp c :=BLACK;
w rr c :=BLACK;
llRotate(x pp);
x:=root;
end;
end
else begin
w := x pp ll;
if(w c= RED) then
begin
w c := BLACK;
x pp c := RED;
rrRotate(x pp);
w := x pp ll;
end;
if (w rr c = BLACK) and (w ll c = BLACK) then
begin
w c := RED;
x := x pp;
end
else begin
if w ll c = BLACK then begin
w rr c :=BLACK;
w c :=RED;
llRotate(w);
w := x pp ll;
end;
w c := x pp c;
x pp c :=BLACK;
w ll c :=BLACK;
rrRotate(x pp);
x:=root;
end;
end;
end;
x c := BLACK;
end;
procedure erase(key : integer);
var x, y, current : PNode;
begin
current := root;
while current <> NULL do begin
if current k = key then break;
if key > current k
then current := current rr
else current := current ll;
end;
if current = NULL then exit;
if (current ll = NULL) or (current rr = NULL) then y := current
else begin y := current rr; while y ll <> NULL do y := y ll; end;
if y ll <> NULL then x := y ll else x := y rr;
x pp := y pp;
if y pp <> nil then begin
if y = y pp ll
then y pp ll := x
else y pp rr := x;
end
else root := x;
current k := y k;
if y c = BLACK then fixErase(x);
Dispose(y);
end;
procedure show(x : PNode);
begin
if x=NULL then exit;
write('(');
show(x ll);
write (' ',x k,' ');
show(x rr);
write(')');
end;
function leftMost : integer;
var current : PNode;
begin
current := root;
while current ll <> NULL do current := current ll;
exit(current k);
end;
function rightMost : integer;
var current : PNode;
begin
current := root;
while current rr <> NULL do current := current rr;
exit(current k);
end;
function succ(key : integer; ch : boolean) : PNode;
var current : PNode;
begin
current := root;
result := nil;
while current <> NULL do begin
if current k = key then
if ch then exit(current)
else
else if current k > key then result := current;
if current k > key
then current := current ll
else current := current rr;
end;
end;
function pred(key : integer; ch : boolean) : PNode;
var current : PNode;
begin
current := root;
result := nil;
while current <> NULL do begin
if current k = key then
if ch then exit(current)
else
else if current k < key then result := current;
if current k >= key
then current := current ll
else current := current rr;
end;
end;
// Main
function get : integer;
begin
read(result);
end;
var x, y : integer;
r : PNode;
begin
with sentinel do
begin
left := @sentinel;
right := @sentinel;
parent := nil;
key := 0;
color := BLACK;
end;
root := NULL;
while not eof do
begin
read(x);
case x of
0 : halt;
1 : insert(get);
2 : erase(get);
3, 4, 5, 6, 7, 8 :
if root = NULL then writeln('empty')
else case x of
3 : writeln(leftMost);
4 : writeln(rightMost);
5, 6 : begin
r := succ(get, x=6);
if r=nil then writeln('no')
else writeln(r k);
end;
7, 8 : begin
r := pred(get, x=8);
if r=nil then writeln('no')
else writeln(r k);
end;
end;
end;
end;
end.
Nhận xét
Code này đã được dùng để nộp cho một bài tập trên SPOJ.