超级高效率 杂乱数据 管理(50)

使用了10的D了，还是有很多地方不清楚，但是感谢有DELPHIBBS的陪伴特地放上一篇红黑树管理内存的代码，希望能抛砖引玉。linux内核中的用户态地址空间管理使用了红黑树(red-black tree)这种数据结构红黑树简介<Google搜索>：http://blog.chinaunix.net/u1/35281/showart_279925.html这篇是随便搜索出来的。下面是在网页搜索N久后，修改出来的东东：unit uRBTree;interfaceuses SysUtils, Windows;type TKey = DWORD
NODECOLOR = ( BLACK = 0, RED = 1 )
PRBNode = ^TRBNode
TRBNode = record parent: PRBNode
left, right: PRBNode
key: TKey
//所有数据都转换成DWord
color: NODECOLOR
Data: pointer
//Data: string
//存储数据..有String的存在，效率将降低一半左右 end;function RB_InsertNode(var root: PRBNode
key: TKey): PRBNode;function RB_InsertNode_Fixup(root: PRBNode
z: PRBNode): PRBNode;function RB_DeleteNode(root: PRBNode
key: TKey): PRBNode;function RB_DeleteNode_Fixup(root: PRBNode
x: PRBNode): PRBNode;function Find_Node(root: PRBNode
key: TKey): PRBNode;procedure Mid_DeleteTree(T: PRBNode);function GetRandom: int64;implementationfunction GetRandom: int64;var iTmp1 : int64;begin QueryPerformanceFrequency(iTmp1)
Sleep(1)
QueryPerformanceFrequency(Result)
Dec(Result, iTmp1);end;(**//*----------------------------------------------------------- | A B | / / ==> / / | a B A y | / / / / | b y a b -----------------------------------------------------------*)procedure Left_Rotate(A: PRBNode
var root: PRBNode);var B : PRBNode;begin B := A^.right
if nil = B then Exit
A^.right := B^.left
if nil <> B^.left then B^.left^.parent := A
B^.parent := A^.parent
// 这样三个判断连在一起避免了A^.parent = NULL的情况 if A = root then begin root := B
end else if A = A^.parent^.left then begin A^.parent^.left := B
end else begin A^.parent^.right := B
end
B^.left := A
A^.parent := B;end;(**//*----------------------------------------------------------- | A B | / / / / | B y ==> a A | / / / / |a b b y -----------------------------------------------------------*)procedure Right_Rotate(A: PRBNode
var root: PRBNode);var B : PRBNode;begin B := A^.left
if nil = B then Exit
A^.left := B^.right
if nil <> B^.right then B^.right^.parent := A
B^.parent := A^.parent
// 这样三个判断连在一起避免了A^.parent = nil的情况 if A = root then begin root := B
end else if A = A^.parent^.left then begin A^.parent^.left := B
end else begin A^.parent^.right := B
end
A^.parent := B
B^.right := A;end;(**/(*----------------------------------------------------------- | 函数作用:查找key值对应的结点指针 | 输入参数:根节点root,待查找关键值key | 返回参数:如果找到返回结点指针,否则返回nil ------------------------------------------------------------- *)function Find_Node(root: PRBNode
key: TKey): PRBNode;var x : PRBNode;begin // 找到key所在的node x := root
repeat if key = x^.key then break
if key < x^.key then begin if nil <> x^.left then x := x^.left else break
end else begin if nil <> x^.right then x := x^.right else break
end
until (nil <> x)
Result := x;end;(**/(*----------------------------------------------------------- | 函数作用:在树中插入key值 | 输入参数:根节点root,待插入结点的关键值key | 返回参数:根节点root ------------------------------------------------------------- *)function RB_InsertNode(var root: PRBNode
key: TKey): PRBNode;var x, y, z : PRBNode;begin //GetMem(z, sizeof(TRBNode))
New(z)
if nil = z then begin OutputDebugString('Memory alloc error')
Result := nil
Exit
end
z^.key := key
z^.Data := nil
// 得到z的父节点 x := root
y := nil
while nil <> x do begin y := x
if z^.key < x^.key then begin if nil <> x^.left then x := x^.left else break
end else begin if nil <> x^.right then x := x^.right else break
end end
// 把z放到合适的位置 z^.parent := y
if nil = y then root := z else begin if z^.key < y^.key then y^.left := z else y^.right := z
end
// 设置z的左右子树为空并且颜色是red，注意新插入的节点颜色都是red z^.left := nil
z^.right := nil
z^.color := RED
// 对红黑树进行修正 root := RB_InsertNode_Fixup(root, z)
Result := z;end;(**/(*----------------------------------------------------------- | 函数作用:对插入key值之后的树进行修正 | 输入参数:根节点root,插入的结点z | 返回参数:根节点root ------------------------------------------------------------- *)function RB_InsertNode_Fixup(root: PRBNode
z: PRBNode): PRBNode;var y : PRBNode;begin while (root <> z) and (RED = z^.parent^.color) do // 当z不是根同时父节点的颜色是red begin if z^.parent = z^.parent^.parent^.left then // 父节点是祖父节点的左子树 begin y := z^.parent^.parent^.right
// y为z的伯父节点 if (nil <> y) and (RED = y^.color) then // 伯父节点存在且颜色是red begin z^.parent^.color := BLACK
// 更改z的父节点颜色是B y^.color := BLACK
// 更改z的伯父节点颜色是B z^.parent^.parent^.color := RED
// 更改z的祖父节点颜色是B z := z^.parent^.parent
// 更新z为它的祖父节点 end else // 无伯父节点或者伯父节点颜色是b begin if z = z^.parent^.right then // 如果新节点是父节点的右子树 begin z := z^.parent
Left_Rotate(z, root)
end
z^.parent^.color := BLACK
// 改变父节点颜色是B z^.parent^.parent^.color := RED
// 改变祖父节点颜色是R Right_Rotate(z^.parent^.parent, root)
end end else // 父节点为祖父节点的右子树 begin y := z^.parent^.parent^.left
// y为z的伯父节点 if (nil <> y) and (RED = y^.color) then // 如果y的颜色是red begin z^.parent^.color := BLACK
// 更改父节点的颜色为B y^.color := BLACK
// 更改伯父节点的颜色是B z^.parent^.parent^.color := RED
// 更改祖父节点颜色是R z := z^.parent^.parent
// 更改z指向祖父节点 end else // y不存在或者颜色是B begin if z = z^.parent^.left then // 如果是父节点的左子树 begin z := z^.parent
Right_Rotate(z, root)
end
z^.parent^.color := BLACK
// 改变父节点的颜色是B z^.parent^.parent^.color := RED
// 改变祖父节点的颜色是RED Left_Rotate(z^.parent^.parent, root)
end end end
// while(RED == z^.parent^.color) // 根节点的颜色始终都是B root^.color := BLACK
Result := root;end;(**/(*----------------------------------------------------------- | 函数作用:在树中删除key值 | 输入参数:根节点root,待插入结点的关键值key | 返回参数:根节点root ------------------------------------------------------------- *)function RB_DeleteNode(root: PRBNode
key: TKey): PRBNode;var x, y, z : PRBNode;begin z := Find_Node(root, key)
if nil = z then begin Result := root
Exit
end
// 当z有一个空子树的时候,y == z // 否则,y是大于z最小的结点 if (nil = z^.left) or (nil = z^.right) then y := z else begin y := z^.right
while nil <> y^.left do y := y^.left
end
// x是y的子树,可能为nil if nil <> y^.left then x := y^.left else x := y^.right
// 设定x的位置取代y if nil <> x then x^.parent := y^.parent
if nil = y^.parent then root := x else if y = y^.parent^.left then y^.parent^.left := x else y^.parent^.right := x
// 把y的key拷贝到z中,这样y就是待删除的结点了 if y <> z then begin z^.key := y^.key
end
// 如果y的颜色值是B,那么要对树进行修正 if (BLACK = y^.color) and (nil <> x) then RB_DeleteNode_Fixup(root, x)
Dispose
Result := root;end;(**/(*----------------------------------------------------------- | 函数作用:对删除key值之后的树进行修正 | 输入参数:根节点root,删除的结点的子结点x | 返回参数:根节点root ------------------------------------------------------------- *)function RB_DeleteNode_Fixup(root: PRBNode
x: PRBNode): PRBNode;var w : PRBNode;begin while (x <> root) and (BLACK = x^.color) do begin if x = x^.parent^.left then // 如果x是左子树 begin w := x^.parent^.right
// w是x的兄弟结点 if nil = w then continue
if RED = w^.color then // 如果w的颜色是红色 begin w^.color := BLACK
x^.parent^.color := RED
Left_Rotate(x^.parent, root)
w := x^.parent^.right
end
if (nil <> w^.left) and (BLACK = w^.left^.color) and (nil <> w^.right) and (BLACK = w^.right^.color) then begin w^.color := RED
x := x^.parent
end else begin if (nil <> w^.right) and (BLACK = w^.right^.color) then begin w^.left^.color := BLACK
w^.color := RED
Right_Rotate(w, root)
w := x^.parent^.right
end
w^.color := x^.parent^.color
x^.parent^.color := BLACK
w^.right^.color := BLACK
Left_Rotate(x^.parent, root)
x := root
end end else begin w := x^.parent^.left
if nil = w then continue
if RED = w^.color then begin w^.color := BLACK
x^.parent^.color := RED
Left_Rotate(x^.parent, root)
w := x^.parent^.left
end
if (nil <> w^.left) and (BLACK = w^.left^.color) and ( nil <> w^.right) and (BLACK = w^.right^.color) then begin w^.color := RED
x := x^.parent
end else begin if (nil <> w^.left) and (BLACK = w^.left^.color) then begin w^.right^.color := BLACK
w^.color := RED
Left_Rotate(w, root)
w := x^.parent^.left
end
w^.color := x^.parent^.color
x^.parent^.color := BLACK
w^.left^.color := BLACK
Right_Rotate(x^.parent, root)
x := root
end end end
x^.color := BLACK
result := root;end;procedure Print_Node(node: PRBNode);const _Color : array[NODECOLOR] of string = ('BLACK', 'RED');begin //char* color[] = begin"", ""end
OutputDebugString(pChar(Format('Key = %d,/tcolor = %s', [node^.key, _color[node^.color]])))
if nil <> node^.parent then OutputDebugString(pChar(',/tparent = ' + IntToStr(node^.parent^.key)))
if nil <> node^.left then OutputDebugString(pChar(',/tleft = ' + IntToStr(node^.left^.key)))
if nil <> node^.right then OutputDebugString(pChar(',/tright = ' + IntToStr(node^.right^.key)))
// OutputDebugString("/n");end;// 中序遍历树procedure Mid_Visit(T: PRBNode);begin if nil <> T then begin if nil <> T^.left then Mid_Visit(T^.left)
Print_Node(T)
if nil <> T^.right then Mid_Visit(T^.right)
endend;// 中序删除树的各个节点procedure Mid_DeleteTree(T: PRBNode);var tmp : PRBNode;begin if nil <> T then begin if nil <> T^.left then Mid_DeleteTree(T^.left)
tmp := T^.right
Dispose(T)
//T := nil
if nil <> tmp then Mid_DeleteTree(tmp)
end;end;end.

object Form3: TForm3 Left = 0 Top = 0 ClientHeight = 246 ClientWidth = 480 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 18 Top = 23 Width = 48 Height = 13 Caption = #29983#25104#24635#25968 end object Label2: TLabel Left = 18 Top = 63 Width = 48 Height = 13 Caption = #25805#20316#27425#25968 end object Button1: TButton Left = 183 Top = 18 Width = 111 Height = 25 Caption = #29983#25104'(x2)' TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 183 Top = 96 Width = 111 Height = 25 Caption = #37322#25918 TabOrder = 1 OnClick = Button2Click end object Button3: TButton Left = 183 Top = 58 Width = 111 Height = 25 Caption = #26597#25214#12289#21024#38500#12289#22686#21152 TabOrder = 2 OnClick = Button3Click end object seMax: TSpinEdit Left = 76 Top = 20 Width = 85 Height = 22 MaxValue = 0 MinValue = 0 TabOrder = 3 Value = 25000000 end object seCount: TSpinEdit Left = 76 Top = 60 Width = 85 Height = 22 MaxValue = 0 MinValue = 0 TabOrder = 4 Value = 100000000 endend

效率：在E5200/2G的机器上操作5000万次插入方式：1,3,5,7,9.....49999997.,49999997，50000000,49999998.....10,8,6,4,2使用时间：10秒以内1亿次随机数的查找、删除、添加，使用时间20秒以内

愚以为，基本上可以满足大家对效率的要求

DEMO ：unit frmTest;interfaceuses uRBTree, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin;type TForm3 = class(TForm) Button1: TButton
Button2: TButton
Button3: TButton
Label1: TLabel
Label2: TLabel
seMax: TSpinEdit
seCount: TSpinEdit
procedure Button1Click(Sender: TObject)
procedure Button2Click(Sender: TObject)
procedure FormCreate(Sender: TObject)
procedure Button3Click(Sender: TObject)
private { Private declarations } public { Public declarations } _root: PRBNode
FMax: integer
end;var Form3 : TForm3;implementation{$R *.dfm}procedure TForm3.Button1Click(Sender: TObject);var i : integer
cTime : TDateTime;begin cTime := Now
FMax:=seMax.Value
for i := 1 to FMax do RB_InsertNode(_root, i + i)
for i := FMax downto 1 do RB_InsertNode(_root, i + i - 1)
ShowMessage(FormatDateTime('完成'+IntToStr(FMax+FMax)+'次添加耗时为：hh:nn:ss:zzz', Now - cTime));end;procedure TForm3.Button2Click(Sender: TObject);begin Mid_DeleteTree(_root)
_root := nil;end;procedure TForm3.Button3Click(Sender: TObject);var i, cMax, cIndex : integer
cTime : TDateTime;begin cMax := FMax + FMax
cTime := Now
for I := 1 to seCount.Value do begin cIndex:= Random(cMax)
if Find_Node(_root, cIndex) <> nil then begin RB_DeleteNode(_root, cIndex)
RB_InsertNode(_root, cIndex)
end else ShowMessage('Not Find ' + IntToStr(cIndex))
end
ShowMessage(FormatDateTime('完成'+IntToStr(seCount.Value)+'次操作耗时为：hh:nn:ss:zzz', Now - cTime));end;procedure TForm3.FormCreate(Sender: TObject);begin FMax := 25000000;end;end.

希望大家多多捧场，多多扔砖

顶起来。

大家对这种东东不感兴趣啊？

感

有兴趣 的XDJM们顶起来啊

太让我失望了。。。。