Implementando un AVL Tree en Delphi
Como se conoce en informática un AVL Tree, es un árbol binario de búsqueda balanceado. De esta manera al ir añadiendo nodos o hojas al árbol, éste se balancea automáticamente para mantener siempre un equilibrio en sus niveles y conseguir que el coste de búsqueda de un valor sea de O(log n). En este artículo aprovecho el trabajo realizado por Nicklaus Wirth y Giacomo Policicchio, y adapto su trabajo para el ejemplo que quiero mostrar, y es el de dibujar el árbol mediante la utilización de métodos abstractos sobre un Timage y mi querido TCanvas. El ejemplo principal, lo podemos encontrar en ibrt, una web dedicada a soluciones científicas e ingeniería. En mi ejemplo Thundax AVL Tree, muestro un pequeño diagrama montando el árbol con su balanceo. Si vamos añadiendo nodos, podremos ver que al final el árbol se ve bastante balanceado. Luego podéis analizar el código y ver como produce el equilibrado hacia la derecha o la izquierda. He adaptado el código para que me permita visualizar los nodos evitando mostrarlos simplemente en un TMemo, de ésta manera podemos asegurar que el algoritmo funciona correctamente y que al final los datos están nivelados.Ejemplo con 8 nodos:
Ejemplo con 1000 nodos:
Podéis descargaros la aplicación desde aquí para que la podáis analizar: Thundax AVL Tree. Además podemos encontrar miles de aplicaciones por la red, y sobretodo applets en Java donde podemos ver su funcionamiento aún mejor:
AVL Tree Java Applet:
http://webpages.ull.es/users/jriera/Docencia/AVL/AVL%20tree%20applet.htm
http://www.site.uottawa.ca/~stan/csi2514/applets/avl/BT.html
http://www.cs.jhu.edu/~goodrich/dsa/trees/avltree.html
Aquí os dejo el código fuente del AVLTree, y su utilización.AVLTree.pas:
// @Author : Jordi Coll 27/06/2009
//
// Taken from Nicklaus Wirth and Giacomo Policicchio:
// Algorithmen und Datenstrukturen ( in Pascal )
// Balanced Binary Trees p 250 ++
//
unit AVLTree;
interface
uses classes, ExtCtrls, Types;
type
TAWLTreeItem = class(TObject)
Left: TAWLTreeItem;
Right: TAWLTreeItem;
balance: - 1..1;
positionL : TPoint;
positionR : TPoint;
private
count: integer;
public
constructor create;
function compare(a: TAWLTreeItem): Shortint; virtual; abstract;
procedure copy(ToA: TAWLTreeItem); virtual; abstract;
procedure list; virtual; abstract;
procedure Draw(point: TPoint; color: integer); virtual; abstract;
procedure DrawLine(pointO, PointD : TPoint; color : integer); virtual; abstract;
end;
TAWLTree = class(TPersistent)
root: TAWLTreeItem;
private
ItemCount: integer;
procedure Delete(item: TAWLTreeItem; var p: TAWLTreeItem; var h: boolean; var ok: boolean);
procedure SearchAndInsert(item: TAWLTreeItem; var p: TAWLTreeItem; var h: boolean; var Found: boolean);
function SearchItem(item: TAWLTreeItem; var p: TAWLTreeItem): boolean;
procedure balanceLeft(var p: TAWLTreeItem; var h: boolean; dl: boolean);
procedure balanceRight(var p: TAWLTreeItem; var h: boolean; dl: boolean);
procedure listitems(var p: TAWLTreeItem);
procedure DrawItems(var p: TAWLTreeItem; node: TPoint);
procedure DrawLines(var p: TAWLTreeItem; node: TPoint);
public
constructor Create;
destructor Destroy; override;
function add(item: TAWLTreeItem): boolean;
function remove(item: TAWLTreeItem): boolean;
function search(item: TAWLTreeItem): boolean;
procedure list;
procedure DrawNodes(Point: TPoint);
end;
implementation
constructor TAWLTreeItem.create;
begin
inherited create;
count := 0;
end;
constructor TAWLTree.create;
begin
inherited create;
root := nil;
ItemCount := 0;
end;
destructor TAWLTree.destroy;
begin
while root <> nil do
remove(root);
inherited destroy;
end;
procedure TAWLTree.SearchAndInsert(item: TAWLTreeItem; var p: TAWLTreeItem; var h: boolean; var Found: boolean);
begin
found := false;
if p = nil then
begin
p := item;
h := true;
with p do
begin
if root = nil then
root := p;
count := 1;
left := nil;
right := nil;
balance := 0;
end;
end
else if (item.compare(p) > 0) then
begin
searchAndInsert(item, p.left, h, found);
if h and not found then
BalanceLeft(p, h, false);
end
else if (item.compare(p) < 0) then
begin
searchAndInsert(item, p.right, h, found);
if h and not found then
balanceRight(p, h, false);
end
else
begin
p.count := p.count + 1;
h := false;
found := true;
end;
end;
function TAWLTree.SearchItem(item: TAWLTreeItem; var p: TAWLTreeItem): boolean;
begin
result := false;
if (p = nil) then
result := false
else
begin
if (item.compare(p) = 0) then
result := true
else
begin
if (item.compare(p) > 0) then
result := searchitem(item, p.left)
else
begin
if (item.compare(p) < 0) then
result := searchitem(item, p.right)
end;
end;
end;
end;
procedure TAWLTree.balanceRight(var p: TAWLTreeItem; var h: boolean; Dl: boolean);
var
p1, p2: TAWLTreeItem;
begin
case p.balance of
-1:
begin
p.balance := 0;
if not dl then
h := false;
end;
0:
begin
p.balance := +1;
if dl then
h := false;
end;
+1:
begin
p1 := p.right;
if (p1.balance = +1) or ((p1.balance = 0) and dl) then
begin
p.right := p1.left;
p1.left := p;
if not dl then
p.balance := 0
else
begin
if p1.balance = 0 then
begin
p.balance := +1;
p1.balance := -1;
h := false;
end
else
begin
p.balance := 0;
p1.balance := 0;
end;
end;
p := p1;
end
else
begin
p2 := p1.left;
p1.left := p2.right;
p2.right := p1;
p.right := p2.left;
p2.left := p;
if p2.balance = +1 then
p.balance := -1
else
p.balance := 0;
if p2.balance = -1 then
p1.balance := +1
else
p1.balance := 0;
p := p2;
if dl then
p2.balance := 0;
end;
if not dl then
begin
p.balance := 0;
h := false;
end;
end;
end;
end;
procedure TAWLTree.balanceLeft(var p: TAWLTreeItem; var h: boolean; dl: boolean);
var
p1, p2: TAWLTreeItem;
begin
case p.balance of
1:
begin
p.balance := 0;
if not dl then
h := false;
end;
0:
begin
p.balance := -1;
if dl then
h := false;
end;
-1:
begin
p1 := p.left;
if (p1.balance = -1) or ((p1.balance = 0) and dl) then
begin
p.left := p1.right;
p1.right := p;
if not dl then
p.balance := 0
else
begin
if p1.balance = 0 then
begin
p.balance := -1;
p1.balance := +1;
h := false;
end
else
begin
p.balance := 0;
p1.balance := 0;
end;
end;
p := p1;
end
else
begin
p2 := p1.right;
P1.Right := p2.left;
p2.left := p1;
p.left := p2.right;
p2.right := p;
if p2.balance = -1 then
p.balance := +1
else
p.balance := 0;
if p2.balance = +1 then
p1.balance := -1
else
p1.balance := 0;
p := p2;
if dl then
p2.balance := 0;
end;
if not dl then
begin
p.balance := 0;
h := false;
end;
end;
end;
end;
procedure TAWLTree.Delete(item: TAWLTreeItem; var p: TAWLTreeItem; var h: boolean; var ok: boolean);
var
q: TAWLTreeItem;
procedure del(var r: TAWLTreeItem; var h: boolean);
begin
if r.right <> nil then
begin
del(r.right, h);
if h then
balanceLeft(r, h, True);
end
else
begin
r.copy(q);
q.count := r.count;
q := r;
r := r.left;
h := true;
end;
end;
begin
ok := true;
if (p = nil) then
begin
Ok := false;
h := false;
end
else if (item.compare(p) > 0) then
begin
delete(item, p.left, h, ok);
if h then
balanceRight(p, h, True);
end
else if (item.compare(p) < 0) then
begin
delete(item, p.right, h, ok);
if h then
balanceLeft(p, h, True);
end
else
begin
q := p;
if q.right = nil then
begin
p := q.left;
h := true;
end
else if (q.left = nil) then
begin
p := q.right;
h := true;
end
else
begin
del(q.left, h);
if h then
balanceRight(p, h, True);
end;
q.free;
end;
end;
function TAWLTree.add(item: TAWLTreeItem): boolean;
var
h, found: boolean;
begin
SearchAndInsert(item, root, h, found);
add := found;
end;
function TAWLTree.remove(item: TAWLTreeItem): Boolean;
var
h, ok: boolean;
begin
Delete(item, root, h, ok);
remove := ok;
end;
function TAWLTree.Search(item: TAWLTreeItem): Boolean;
begin
result := SearchItem(item, root);
end;
procedure TAWLTree.listitems(var p: TAWLTreeItem);
begin
if p <> nil then
begin
if (p.left <> nil) then
listitems(p.left);
p.list;
if (p.right <> nil) then
listitems(p.right);
end;
end;
procedure TAWLTree.list;
begin
listitems(root);
end;
procedure TAWLTree.DrawItems(var p: TAWLTreeItem; node: TPoint);
var
pLeft, pRight : TPoint;
begin
if p <> nil then
begin
if (p.left <> nil) then
begin
pLeft := Point(node.x - 6, node.y + 20);
p.Draw(pLeft, $003005FA);
p.positionL := pLeft;
DrawItems(p.left, Point(pLeft.x - 3 , pLeft.y + 20));
end;
if (p.right <> nil) then
begin
pRight := point(node.x + 6, node.y + 20);
p.Draw(pRight, $005BFD84);
p.positionR := pRight;
DrawItems(p.right, Point(pRight.x + 3 , pRight.y + 20));
end;
end;
end;
procedure TAWLTree.DrawLines(var p: TAWLTreeItem; node: TPoint);
begin
if p <> nil then
begin
if (p.left <> nil) then
begin
p.DrawLine(node, p.positionL, $00F7F7F7);
DrawLines(p.left, p.positionL);
end;
if (p.right <> nil) then
begin
p.DrawLine(node, p.positionR, $00F7F7F7);
DrawLines(p.right, p.positionR);
end;
end;
end;
procedure TAWLTree.DrawNodes(Point: TPoint);
begin
root.Draw(Point, $004AFFFF);
root.positionL := Point;
root.positionR := Point;
DrawItems(root, Point);
DrawLines(root,Point);
end;
end.
Utilización:
type
TmyTreeItem = class(TAWLTreeItem)
public
data: integer;
constructor create(i: integer);
function compare(a: TAWLTreeItem): Shortint; override;
procedure copy(ToA: TAWLTreeItem); override;
procedure list; override;
procedure Draw(point: TPoint; color: integer); override;
procedure DrawLine(pointO, PointD: TPoint; color: integer); override;
end;
constructor TmyTreeItem.create(i: integer);
begin
inherited create;
data := i;
end;
function TmyTreeItem.compare(a: TAWLTreeItem): Shortint;
begin
result := 0;
if TmyTreeItem(a).data < data then
result := -1
else if TmyTreeItem(a).data = data then
result := 0
else if TmyTreeItem(a).data > data then
result := 1;
end;
procedure TmyTreeItem.copy(ToA: TAWLTreeItem);
begin
TmyTreeItem(ToA).data := data;
end;
procedure TmyTreeItem.list;
begin
form3.memo1.lines.add(inttostr(data));
end;
procedure TmyTreeItem.Draw(point: TPoint; color: integer);
begin
form3.DrawPoint(point, color);
end;
procedure TmyTreeItem.DrawLine(pointO, PointD: TPoint; color: integer);
begin
form3.DrawLine(pointO, pointD, color);
end;
procedure TForm3.Button2Click(Sender: TObject);
begin
bt.remove(TmyTreeItem.create(StrToInt(Edit3.text)));
listClick(sender);
end;
procedure TForm3.AddData(Sender: TObject);
var
bti: TmyTreeItem;
i: integer;
begin
bt.destroy;
bt := TAWLTree.create;
for i := 0 to StrToInt(Edit1.text) - 1 do
begin
bti := TmyTreeItem.create(1 + random(11) + random(10000));
bt.add(bti);
end;
listing();
end;
procedure TForm3.listing();
begin
memo1.clear;
bt.list;
DrawRectangle(image1, clblack, clblack);
bt.DrawNodes(Point(219, 10));
end;
Fijaros en la implementación de la utilización de la clase TAWLTreeItem donde todos sus métodos son abstractos. Luego en la clase que hereda de esta, sobreescribo los métodos y los redirecciono al formulario donde tengo el TImage. Luego a partir de unos puntos calculados dibujo éstos en el formulario y hago las conexiones guardándome la posición del nodo.
Éste ejemplo es meramente didáctico y puede que a algún estudiante le pueda ayudar a entender un poco mejor esta estructura de datos. Podemos encontrar diversas implementaciones del algoritmo en diferentes lenguajes. También os dejo un recopilatorio de enlaces dónde podemos encontrar el código fuente de ésta EI y poder utilizarla en nuestras aplicaciones.
Java AVL Tree:
AVLTree.java
C AVL Tree:
AVLTree.c
Ruby AVL Tree:
RubyAVL
- Enlaces de interés:
Árbol AVL
Comments
Post a Comment