这是最后的版本（仅列出算法部分，有兴趣者可索要全部代码）：
type
TIndexedChainedList = class;
TCompareMethod = function(Key, Dest: Pointer): Integer of object;
TBalance = (nbLeftTilt, nbNeutral, nbRightTilt);
// 双平衡二叉树结点结构
// 第一部分记录关键字项,每一关键字一个结点,按关键字搜索
// 第二部分记录用户自定义项,每一项一个结点,按实体搜索,并可引用关键字项
PAVLNodeDesc = ^TAVLNodeDesc;
// 全局结点管理器管理
TAVLNodeDesc = packed record
Left, Right: PAVLNodeDesc;
// 二叉树左右结点
Balance: TBalance;
// 平衡状态
case Integer of
0: (Key: Pointer;
// 关键字
EntityNode: PAVLNodeDesc;
// 指向第一个索引结点
DummyNode: Pointer);
// 空指针，区别两类结点
1: (Entity: Pointer;
// 实体结构
Next: PAVLNodeDesc;
// 指向下一项索引节点
KeyNode: PAVLNodeDesc);
// 指向主关键结点
end;
{******************************************************************************}
{ }
{ 双平衡二叉树函数 }
{ 建立和维护双平衡二叉树 }
{ }
{ 两棵平衡二叉树中只有第一棵是按用户自定义关键字建立的，称为关键树 }
{ 第二棵仅仅是第一棵树的实体项索引，称为搜索树 }
{ 搜索树唯一的作用是根据实体找到该实体所在的关键字项 }
{ 这样，在释放实体是保证不需要用关键字来寻找关键字结点 }
{ }
{ 搜索树自维护，建立关键字项时，自动建立实体搜索项 }
{ }
{******************************************************************************}
function AVLCompareKey(Index: PIndexDesc;
Key, Entity: Pointer): TBalance;
// 根据索引项提供的方法比较关键字,由平衡二叉树寻找结点和重新平衡时调用
var
I: Integer;
begin
Result := nbNeutral;
if Assigned(Index^.Method) then
begin
I := Index^.Method(Key, Entity);
if I < 0 then
Result := nbLeftTilt
else
if I > 0 then
Result := nbRightTilt;
end;
end;
function AVLAccessFromKey(Index: PIndexDesc;
Key: Pointer;
Src: PAVLNodeDesc;
var Dest: PAVLNodeDesc): Boolean;
// 在关键树中搜索关键字项
begin
if Src = nil then
Result := False
else
case AVLCompareKey(Index, Key, Src^.EntityNode^.Entity) of
nbLeftTilt:
Result := AVLAccessFromKey(Index, Key, Src^.Left, Dest);
nbRightTilt:
Result := AVLAccessFromKey(Index, Key, Src^.Right, Dest);
else
Result := True;
Dest := Src;
end;
end;
procedure AVLRotateLeft(var Node: PAVLNodeDesc);
// 向左旋转二叉树
var
Inst: PAVLNodeDesc;
begin
Inst := Node^.Right;
Node^.Right := Inst^.Left;
Inst^.Left := Node;
Node := Inst;
end;
procedure AVLRotateRight(var Node: PAVLNodeDesc);
// 向右旋转二叉树
var
Inst: PAVLNodeDesc;
begin
Inst := Node^.Left;
Node^.Left := Inst^.Right;
Inst^.Right := Node;
Node := Inst;
end;
procedure AVLGrownLeft(var Node: PAVLNodeDesc;
var State: Boolean);
// 结点向左生长
begin
case Node^.Balance of
nbLeftTilt:
begin
if Node^.Left^.Balance = nbLeftTilt then
begin
Node^.Left^.Balance := nbNeutral;
Node^.Balance := nbNeutral;
AVLRotateRight(Node);
end
else
begin
case Node^.Left^.Right^.Balance of
nbLeftTilt:
begin
Node^.Balance := nbRightTilt;
Node^.Left^.Balance := nbNeutral;
end;
nbRightTilt:
begin
Node^.Balance := nbNeutral;
Node^.Left^.Balance := nbLeftTilt;
end;
else
Node^.Balance := nbNeutral;
Node^.Left^.Balance := nbNeutral;
end;
Node^.Left^.Right^.Balance := nbNeutral;
AVLRotateLeft(Node^.Left);
AVLRotateRight(Node);
end;
State := False;
end;
nbRightTilt:
begin
Node^.Balance := nbNeutral;
State := False;
end;
else
Node^.Balance := nbLeftTilt;
State := True;
end;
end;
procedure AVLGrownRight(var Node: PAVLNodeDesc;
var State: Boolean);
// 结点向右生长
begin
case Node^.Balance of
nbLeftTilt:
begin
Node^.Balance := nbNeutral;
State := False;
end;
nbRightTilt:
begin
if Node^.Right^.Balance = nbRightTilt then
begin
Node^.Balance := nbNeutral;
Node^.Right^.Balance := nbNeutral;
AVLRotateLeft(Node);
end
else
begin
case Node^.Right^.Left^.Balance of
nbRightTilt:
begin
Node^.Balance := nbLeftTilt;
Node^.Right^.Balance := nbNeutral;
end;
nbLeftTilt:
begin
Node^.Balance := nbNeutral;
Node^.Right^.Balance := nbRightTilt;
end;
else
Node^.Balance := nbNeutral;
Node^.Right^.Balance := nbNeutral;
end;
Node^.Right^.Left^.Balance := nbNeutral;
AVLRotateRight(Node^.Right);
AVLRotateLeft(Node);
end;
State := False;
end;
else
Node^.Balance := nbRightTilt;
State := True;
end;
end;
procedure AVLInsertKeyInto(Index: PIndexDesc;
var Node: PAVLNodeDesc;
Key, Entity: Pointer;
EntityNode: PAVLNodeDesc;
var State: Boolean);
// 添加一个关键项到关键树
var
Next: PAVLNodeDesc;
begin
if Node = nil then
begin
Node := GlobalCreateKeyNode(Index);
//在此添加一片叶
Node^.Left := nil;
Node^.Right := nil;
Node^.Balance := nbNeutral;
Node^.Key := Key;
Node^.EntityNode := EntityNode;
Node^.DummyNode := nil;
EntityNode^.KeyNode := Node;
Index^.LastKeyNode := Node;
State := True;
end
else
case AVLCompareKey(Index, Key, Node^.EntityNode^.Entity) of
nbLeftTilt: // 向左搜索
begin
AVLInsertKeyInto(Index, Node^.Left, Key, Entity, EntityNode, State);
if State then
// 左子树变深
AVLGrownLeft(Node, State);
end;
nbRightTilt: // 向右搜索
begin
AVLInsertKeyInto(Index, Node^.Right, Key, Entity, EntityNode, State);
if State then
// 右子树变深
AVLGrownRight(Node, State);
end;
else
// 关键字相重
State := False;
Next := Node^.EntityNode;
while Next^.Next <> nildo
// 轮询所有的实体结点
Next := Next^.Next;
Next^.Next := EntityNode;
EntityNode^.KeyNode := Node;
end;
end;
procedure AVLInsertEntityInto(Index: PIndexDesc;
var Node: PAVLNodeDesc;
Key, Entity: Pointer;
var State: Boolean);
// 添加一个实体搜索项到搜索树,由关键树维护函数调用
begin
if Node = nil then
begin
Node := GlobalCreateEntityNode(Index);
//在此添加一片叶
Node^.Left := nil;
Node^.Right := nil;
Node^.Entity := Entity;
Node^.Balance := nbNeutral;
Node^.Next := nil;
Index^.LastEntityNode := Node;
State := False;
AVLInsertKeyInto(Index, Index^.KeyRoot, Key, Entity, Node, State);
State := True;
end
else
//实体不允许重复，所以不需要维护重复项
if Longint(Entity) < Longint(Node^.Entity) then
// 向左搜索
begin
AVLInsertEntityInto(Index, Node^.Left, Key, Entity, State);
if State then
// 左子树变深
AVLGrownLeft(Node, State);
end
else
if Longint(Entity) > Longint(Node^.Entity) then
// 向右搜索
begin
AVLInsertEntityInto(Index, Node^.Right, Key, Entity, State);
if State then
// 右子树变深
AVLGrownRight(Node, State);
end;
end;
procedure AVLShrunkLeft(var Node: PAVLNodeDesc;
var State: Boolean);
// 结点向左收缩
begin
case Node^.Balance of
nbLeftTilt:
begin
Node^.Balance := nbNeutral;
State := True;
end;
nbRightTilt:
begin
if Node^.Right^.Balance = nbRightTilt then
begin
Node^.Balance := nbNeutral;
Node^.Right^.Balance := nbNeutral;
AVLRotateLeft(Node);
State := True;
end
else
if Node^.Right^.Balance = nbNeutral then
begin
Node^.Balance := nbRightTilt;
Node^.Right^.Balance := nbLeftTilt;
AVLRotateLeft(Node);
State := False;
end
else
begin
case Node^.Right^.Left^.Balance of
nbLeftTilt:
begin
Node^.Balance := nbNeutral;
Node^.Right^.Balance := nbRightTilt;
end;
nbRightTilt:
begin
Node^.Balance := nbLeftTilt;
Node^.Right^.Balance := nbNeutral;
end;
else
Node^.Balance := nbNeutral;
Node^.Right^.Balance := nbNeutral;
end;
Node^.Right^.Left^.Balance := nbNeutral;
AVLRotateRight(Node^.Right);
AVLRotateLeft(Node);
State := True;
end;
end;
else
Node^.Balance := nbRightTilt;
State := False;
end;
end;
procedure AVLShrunkRight(var Node: PAVLNodeDesc;
var State: Boolean);
// 结点向右收缩
begin
case Node^.Balance of
nbRightTilt:
begin
Node^.Balance := nbNeutral;
State := True;
end;
nbLeftTilt:
begin
if Node^.Left^.Balance = nbLeftTilt then
begin
Node^.Balance := nbNeutral;
Node^.Left^.Balance := nbNeutral;
AVLRotateRight(Node);
State := True;
end
else
if Node^.Left^.Balance = nbNeutral then
begin
Node^.Balance := nbLeftTilt;
Node^.Left^.Balance := nbRightTilt;
AVLRotateRight(Node);
State := False;
end
else
begin
case Node^.Left^.Right^.Balance of
nbLeftTilt:
begin
Node^.Balance := nbRightTilt;
Node^.Left^.Balance := nbNeutral;
end;
nbRightTilt:
begin
Node^.Balance := nbNeutral;
Node^.Left^.Balance := nbLeftTilt;
end;
else
Node^.Balance := nbNeutral;
Node^.Left^.Balance := nbNeutral;
end;
Node^.Left^.Right^.Balance := nbNeutral;
AVLRotateLeft(Node^.Left);
AVLRotateRight(Node);
State := True;
end;
end;
else
Node^.Balance := nbLeftTilt;
State := False;
end;
end;
procedure AVLDeleteKeyFrom(Index: PIndexDesc;
var Node: PAVLNodeDesc;
Key: Pointer;
var State: Boolean);
forward;
procedure AVLRemoveNode(Index: PIndexDesc;
Src, Dest: PAVLNodeDesc);
// 执行删除
// Index: 索引对象
// Src/Dest: 源结点/目标结点：将目标结点Dest的内容移到Src上
var
KeyNode, EntityNode, NextNode, RelNode: PAVLNodeDesc;
State: Boolean;
begin
if Dest^.DummyNode = nil then
begin
// 关键结点
if Src <> nil then
begin
Src^.Key := Dest^.Key;
Src^.EntityNode := Dest^.EntityNode;
EntityNode := Src^.EntityNode;
while EntityNode <> nildo
begin
EntityNode^.KeyNode := Src;
EntityNode := EntityNode^.Next;
end;
end;
GlobalReleaseKeyNode(Index, Dest);
end
else
begin
// 索引结点
// 先维护关键结点
if Src <> nil then
RelNode := Src
else
RelNode := Dest;
KeyNode := RelNode^.KeyNode;
NextNode := RelNode^.Next;
if KeyNode^.EntityNode = RelNode then
begin
// 关键结点的第一个索引结点
if NextNode = nil then
begin
State := False;
AVLDeleteKeyFrom(Index, Index^.KeyRoot, KeyNode^.Key, State);
end
else
KeyNode^.EntityNode := NextNode;
end
else
begin
// 不是第一个结点,在链中删除
EntityNode := KeyNode^.EntityNode;
while EntityNode^.Next <> RelNodedo
EntityNode := EntityNode^.Next;
EntityNode^.Next := NextNode;
end;
// 替换属性
if Src <> nil then
begin
Src^.Entity := Dest^.Entity;
Src^.KeyNode := Dest^.KeyNode;
EntityNode := Dest^.KeyNode^.EntityNode;
if EntityNode = Dest then
begin
// 加到首项
Src^.Next := EntityNode^.Next;
Src^.KeyNode^.EntityNode := Src;
end
else
begin
// 加到中间项或尾部
while EntityNode^.Next <> Destdo
EntityNode := EntityNode^.Next;
Src^.Next := EntityNode^.Next^.Next;
EntityNode^.Next := Src;
end;
end;
GlobalReleaseEntityNode(Index, Dest);
end;
end;
function AVLFindHighest(Index: PIndexDesc;
Src: PAVLNodeDesc;
var Node: PAVLNodeDesc;
var State: Boolean): Boolean;
// 搜索树的最右结点,用于旋转置换
begin
State := True;
if Node = nil then
Result := False
else
if Node^.Right <> nil then
begin
if AVLFindHighest(Index, Src, Node^.Right, State) then
begin
if State then
AVLShrunkRight(Node, State);
Result := True;
end
else
Result := False;
end
else
begin
// 执行删除
AVLRemoveNode(Index, Src, Node);
Node := Node^.Left;
Result := True;
end;
end;
function AVLFindLowest(Index: PIndexDesc;
Src: PAVLNodeDesc;
var Node: PAVLNodeDesc;
var State: Boolean): Boolean;
begin
State := True;
if Node = nil then
Result := False
else
if Node^.Left <> nil then
begin
if AVLFindLowest(Index, Src, Node^.Left, State) then
begin
if State then
AVLShrunkLeft(Node, State);
Result := True;
end
else
Result := False;
end
else
begin
// 执行删除
AVLRemoveNode(Index, Src, Node);
Node := Node^.Right;
Result := True;
end;
end;
procedure AVLDeleteKeyFrom(Index: PIndexDesc;
var Node: PAVLNodeDesc;
Key: Pointer;
var State: Boolean);
// 从关键树释放一个关键项
begin
if Node = nil then
State := False
else
case AVLCompareKey(Index, Key, Node^.EntityNode^.Entity) of
nbLeftTilt:
begin
AVLDeleteKeyFrom(Index, Node^.Left, Key, State);
if State then
AVLShrunkLeft(Node, State);
end;
nbRightTilt:
begin
AVLDeleteKeyFrom(Index, Node^.Right, Key, State);
if State then
AVLShrunkRight(Node, State);
end;
else
State := False;
if Node^.Left <> nil then
begin
if AVLFindHighest(Index, Node, Node^.Left, State) then
if State then
AVLShrunkLeft(Node, State);
end
else
if Node^.Right <> nil then
begin
if AVLFindLowest(Index, Node, Node^.Right, State) then
if State then
AVLShrunkRight(Node, State);
end
else
begin
// 执行删除
AVLRemoveNode(Index, nil, Node);
Node := nil;
State := True;
end;
end;
end;
procedure AVLDeleteEntityFrom(Index: PIndexDesc;
var Node: PAVLNodeDesc;
Entity: Pointer;
var State: Boolean);
// 从搜索树释放一个实体搜索项,由关键树维护函数调用
begin
if Node = nil then
State := False
else
if Longint(Entity) < Longint(Node^.Entity) then
// 向左搜索
begin
AVLDeleteEntityFrom(Index, Node^.Left, Entity, State);
if State then
AVLShrunkLeft(Node, State);
end
else
if Longint(Entity) > Longint(Node^.Entity) then
// 向右搜索
begin
AVLDeleteEntityFrom(Index, Node^.Right, Entity, State);
if State then
AVLShrunkRight(Node, State);
end
else
begin
// 已找到
if Node^.Left <> nil then
begin
if AVLFindHighest(Index, Node, Node^.Left, State) then
if State then
AVLShrunkLeft(Node, State);
end
else
if Node^.Right <> nil then
begin
if AVLFindLowest(Index, Node, Node^.Right, State) then
if State then
AVLShrunkRight(Node, State);
end
else
begin
// 最后删除搜索树中的项
AVLRemoveNode(Index, nil, Node);
Node := nil;
State := True;
end;
end;
end;
]