479 lines
9.8 KiB
ObjectPascal
479 lines
9.8 KiB
ObjectPascal
program tree;
|
|
type TreedataType = (TDString, TDInteger);
|
|
type Treedata = record
|
|
case typ:Treedatatype of
|
|
TDString:(stringdata:string);
|
|
TDInteger:(intdata:integer);
|
|
end;
|
|
type TreeNode = record
|
|
parent: ^TreeNode;
|
|
left,right: ^TreeNode;
|
|
height: integer;
|
|
key: ^string;
|
|
data: ^Treedata;
|
|
end;
|
|
|
|
type TreeRef = ^TreeNode;
|
|
|
|
type TreeWalkState = record
|
|
currentNode:TreeRef;
|
|
end;
|
|
|
|
var t:TreeRef;
|
|
k:string;
|
|
d:TreeData;
|
|
i:integer;
|
|
searchres:^Treedata;
|
|
walkState:TreeWalkState;
|
|
walkRes:TreeRef;
|
|
|
|
procedure mem_dump; external;
|
|
|
|
function makeTreeNode(var d:TreeData;var key:string;nparent:TreeRef):TreeRef;
|
|
var newNode:TreeRef;
|
|
newKey:^string;
|
|
begin
|
|
new(newNode);
|
|
new(newKey,length(key));
|
|
{ new(newKey); }
|
|
new(newNode^.data);
|
|
newKey^ := key;
|
|
with newNode^ do
|
|
begin
|
|
key := newKey;
|
|
parent := nparent;
|
|
left := nil;
|
|
right := nil;
|
|
height := 1;
|
|
data^ := d;
|
|
end;
|
|
makeTreeNode := newNode;
|
|
end;
|
|
|
|
function MeasureTree(root:TreeRef):integer;
|
|
var leftHeight, rightHeight:integer;
|
|
begin
|
|
if root = nil then
|
|
MeasureTree := 0
|
|
else
|
|
begin
|
|
if root^.left <> nil then
|
|
leftHeight := root^.left^.height
|
|
else
|
|
leftHeight := 0;
|
|
if root^.right <> nil then
|
|
rightHeight := root^.right^.height
|
|
else
|
|
rightHeight := 0;
|
|
if rightHeight > leftHeight then
|
|
MeasureTree := rightHeight + 1
|
|
else
|
|
MeasureTree := leftHeight + 1;
|
|
end;
|
|
end;
|
|
|
|
function GetTreeBalance(root:TreeRef):integer;
|
|
begin
|
|
if root = nil then
|
|
GetTreeBalance := 0
|
|
else
|
|
GetTreeBalance := MeasureTree(root^.left) - MeasureTree(root^.right);
|
|
end;
|
|
|
|
function RotateTreeRight(x:TreeRef):TreeRef;
|
|
var z,tmp:TreeRef;
|
|
begin
|
|
writeln('RotateTreeRight at ', x^.key^);
|
|
z := x^.left;
|
|
tmp := z^.right;
|
|
z^.right := x;
|
|
z^.parent := x^.parent;
|
|
x^.parent := z;
|
|
x^.left := tmp;
|
|
if tmp <> nil then
|
|
tmp^.parent := x;
|
|
x^.height := MeasureTree(x);
|
|
z^.height := MeasureTree(z);
|
|
RotateTreeRight := z;
|
|
end;
|
|
|
|
function RotateTreeLeft(x:TreeRef):TreeRef;
|
|
var z,tmp:TreeRef;
|
|
begin
|
|
writeln('RotateTreeLeft at ', x^.key^);
|
|
z := x^.right;
|
|
tmp := z^.left;
|
|
z^.left := x;
|
|
z^.parent := x^.parent;
|
|
x^.parent := z;
|
|
x^.right := tmp;
|
|
if tmp <> nil then
|
|
tmp^.parent := x;
|
|
x^.height := MeasureTree(x);
|
|
z^.height := MeasureTree(z);
|
|
RotateTreeLeft := z;
|
|
end;
|
|
|
|
function TreeInsert4(root:TreeRef;var key:string;var data:TreeData;
|
|
parent:TreeRef):TreeRef;
|
|
var balance:integer;
|
|
begin
|
|
if root = nil then
|
|
root := makeTreeNode(data, key, parent)
|
|
else
|
|
if key < root^.key^ then
|
|
root^.left := TreeInsert4(root^.left, key, data, root)
|
|
else
|
|
root^.right := TreeInsert4(root^.right, key, data, root);
|
|
|
|
root^.height := MeasureTree(root);
|
|
|
|
balance := GetTreeBalance(root);
|
|
if balance > 1 then
|
|
begin
|
|
if key < root^.left^.key^ then
|
|
root := RotateTreeRight(root)
|
|
else
|
|
begin
|
|
root^.left := RotateTreeLeft(root^.left);
|
|
root := RotateTreeRight(root);
|
|
end;
|
|
end
|
|
else
|
|
if balance < -1 then
|
|
begin
|
|
if key > root^.right^.key^ then
|
|
root := RotateTreeLeft(root)
|
|
else
|
|
begin
|
|
root^.right := RotateTreeRight(root^.right);
|
|
root := RotateTreeLeft(root);
|
|
end;
|
|
end;
|
|
|
|
TreeInsert4 := root;
|
|
end;
|
|
|
|
procedure TreeInsert(var root:TreeRef;var key:string;var data:TreeData);
|
|
begin
|
|
root := TreeInsert4(root,key,data,nil);
|
|
end;
|
|
|
|
procedure DisposeTreeNode(node:TreeRef);
|
|
begin
|
|
dispose(node^.key);
|
|
dispose(node^.data);
|
|
dispose(node);
|
|
end;
|
|
|
|
function TreeLeftmost(node:TreeRef):TreeRef;
|
|
begin
|
|
TreeLeftmost := nil;
|
|
if node <> nil then
|
|
begin
|
|
repeat
|
|
TreeLeftmost := node;
|
|
node := node^.left;
|
|
until node = nil;
|
|
end;
|
|
end;
|
|
|
|
procedure PrintTreeRef(node:TreeRef);
|
|
begin
|
|
if node = nil then
|
|
write('nil')
|
|
else
|
|
write(node^.key^);
|
|
end;
|
|
|
|
procedure PrintTreeNode(node:TreeRef);
|
|
begin
|
|
write(' -');
|
|
PrintTreeRef(node);
|
|
if node <> nil then
|
|
begin
|
|
write(' ^');
|
|
PrintTreeRef(node^.parent);
|
|
write(' <');
|
|
PrintTreeRef(node^.left);
|
|
write(' >');
|
|
PrintTreeRef(node^.right);
|
|
end;
|
|
writeln;
|
|
end;
|
|
|
|
function TreeDeleteFn(root:TreeRef;var key:string):TreeRef;
|
|
var tmp,oldParent:TreeRef;
|
|
balance:integer;
|
|
begin
|
|
if root <> nil then
|
|
begin
|
|
if key < root^.key^ then
|
|
root^.left := TreeDeleteFn(root^.left, key)
|
|
else
|
|
if key > root^.key^ then
|
|
root^.right := TreeDeleteFn(root^.right, key)
|
|
else
|
|
begin
|
|
if root^.left = nil then
|
|
begin
|
|
tmp := root;
|
|
oldParent := root^.parent;
|
|
root := root^.right;
|
|
if root <> nil then
|
|
root^.parent := oldParent;
|
|
DisposeTreeNode(tmp);
|
|
end
|
|
else
|
|
if root^.right = nil then
|
|
begin
|
|
tmp := root;
|
|
oldParent := root^.parent;
|
|
root := root^.left;
|
|
if root <> nil then
|
|
root^.parent := oldParent;
|
|
DisposeTreeNode(tmp);
|
|
end
|
|
else
|
|
begin
|
|
writeln('TreeDelete search leftmost from ', root^.key^);
|
|
PrintTreeNode(root);
|
|
tmp := TreeLeftmost(root^.right);
|
|
if maxlength(tmp^.key^) <> maxlength(root^.key^) then
|
|
begin (* reallocate key, the swapped key might have a different length *)
|
|
write('reallocating key ', length(root^.key^));
|
|
dispose(root^.key);
|
|
new(root^.key, length(tmp^.key^));
|
|
writeln(' -> ', maxlength(root^.key^));
|
|
end;
|
|
root^.key^ := tmp^.key^;
|
|
root^.data^ := tmp^.data^;
|
|
writeln('TreeDelete delete leftmost ', tmp^.key^);
|
|
PrintTreeNode(tmp);
|
|
writeln('oldParent: ');
|
|
PrintTreeNode(tmp^.parent);
|
|
oldParent := tmp^.parent;
|
|
if oldParent^.left = tmp then
|
|
oldParent^.left := TreeDeleteFn(oldParent^.left, tmp^.key^)
|
|
else
|
|
if oldParent^.right = tmp then
|
|
oldParent^.right := TreeDeleteFn(oldParent^.right, tmp^.key^)
|
|
else
|
|
writeln('TreeDelete internal error');
|
|
end;
|
|
|
|
if root <> nil then
|
|
begin
|
|
root^.height := MeasureTree(root);
|
|
balance := GetTreeBalance(root);
|
|
if balance > 1 then
|
|
begin
|
|
if GetTreeBalance(root^.left) >=0 then
|
|
root := RotateTreeRight(root)
|
|
else
|
|
begin
|
|
root^.left := RotateTreeLeft(root^.left);
|
|
root := RotateTreeRight(root);
|
|
end;
|
|
end
|
|
else
|
|
if balance < -1 then
|
|
begin
|
|
if GetTreeBalance(root^.right) <= 0 then
|
|
root^.right := RotateTreeLeft(root)
|
|
else
|
|
begin
|
|
root^.right := RotateTreeRight(root^.right);
|
|
root := RotateTreeLeft(root);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
TreeDeleteFn := root;
|
|
end;
|
|
|
|
procedure TreeDelete(var root:TreeRef;var key:string);
|
|
begin
|
|
root := TreeDeleteFn(root,key);
|
|
end;
|
|
|
|
function TreeSearch(root:TreeRef;var key:string):^TreeData;
|
|
begin
|
|
if root <> nil then
|
|
begin
|
|
if key = root^.key^ then
|
|
TreeSearch := root^.data
|
|
else
|
|
if key < root^.key^ then
|
|
TreeSearch := TreeSearch(root^.left, key)
|
|
else
|
|
TreeSearch := TreeSearch(root^.right, key);
|
|
end
|
|
else
|
|
TreeSearch := nil;
|
|
end;
|
|
|
|
procedure TreeWalkStart(t:TreeRef; var state:TreeWalkState);
|
|
begin
|
|
(* start at leftmost node of the tree *)
|
|
state.currentNode := TreeLeftmost(t);
|
|
end;
|
|
|
|
procedure TreeWalkNext(var state:TreeWalkState;var res:TreeRef);
|
|
var last,current,old,right:TreeRef;
|
|
begin
|
|
current := state.currentNode;
|
|
|
|
res := current;
|
|
|
|
if current <> nil then
|
|
begin
|
|
(* descending right *)
|
|
if current^.right <> nil then
|
|
begin
|
|
state.currentNode := TreeLeftmost(current^.right);
|
|
end
|
|
else (* ascending *)
|
|
begin
|
|
old := current;
|
|
repeat
|
|
last := current;
|
|
current := current^.parent;
|
|
if current <> nil then
|
|
right := current^.right;
|
|
until (right <> last) or (current = nil); (* ascend left edges *)
|
|
state.currentNode := current;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure indent(i:integer);
|
|
var c:integer;
|
|
begin
|
|
for c := 1 to i do
|
|
write(' ');
|
|
end;
|
|
|
|
procedure PrintStringTree(node:TreeRef;level:integer);
|
|
begin
|
|
if node <> nil then
|
|
begin
|
|
if node^.left <> nil then
|
|
PrintStringTree(node^.left, level + 1);
|
|
indent(level);
|
|
PrintTreeNode(node);
|
|
if node^.right <> nil then
|
|
PrintStringTree(node^.right, level + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure DoASearch(t:TreeRef; s:string);
|
|
var res:^TreeData;
|
|
begin
|
|
res := TreeSearch(t, s);
|
|
write('searching for ',s);
|
|
if res = nil then
|
|
writeln(' nil')
|
|
else
|
|
writeln(res^.stringdata);
|
|
end;
|
|
|
|
begin
|
|
mem_dump;
|
|
{
|
|
t := nil;
|
|
k := 'test1';
|
|
d.typ := TDString;
|
|
d.stringdata := 'data1';
|
|
TreeInsert(t,k,d);
|
|
|
|
k := 'test0';
|
|
d.typ := TDString;
|
|
d.stringdata := 'data0';
|
|
TreeInsert(t,k,d);
|
|
|
|
k := 'test3';
|
|
d.typ := TDString;
|
|
d.stringdata := 'data3';
|
|
TreeInsert(t,k,d);
|
|
|
|
k := 'test2';
|
|
d.typ := TDString;
|
|
d.stringdata := 'data2';
|
|
TreeInsert(t,k,d);
|
|
|
|
k := 'test4';
|
|
d.typ := TDString;
|
|
d.stringdata := 'data4';
|
|
TreeInsert(t,k,d);
|
|
|
|
writeln('root: ', t^.key^);
|
|
|
|
PrintStringTree(t,1);
|
|
}
|
|
writeln('------------');
|
|
|
|
t := nil;
|
|
d.typ := TDString;
|
|
d.stringdata := 'data';
|
|
|
|
for i := 1 to 30 do
|
|
begin
|
|
str(i,k);
|
|
d.stringdata := 'data' + k;
|
|
k := 'test' + k;
|
|
TreeInsert(t,k,d);
|
|
|
|
if i >99 then
|
|
begin
|
|
writeln('root: ', t^.key^);
|
|
PrintStringTree(t,1);
|
|
writeln('------------');
|
|
readln;
|
|
end;
|
|
end;
|
|
|
|
writeln('root: ', t^.key^);
|
|
PrintStringTree(t,1);
|
|
writeln('------------');
|
|
|
|
|
|
DoASearch(t,'test21');
|
|
DoASearch(t,'test2');
|
|
DoASearch(t,'test17');
|
|
|
|
k := 'test17';
|
|
TreeDelete(t,k);
|
|
writeln('root: ', t^.key^);
|
|
PrintStringTree(t,1);
|
|
writeln('------------');
|
|
DoASearch(t,'test17');
|
|
|
|
|
|
|
|
TreeWalkStart(t, walkState);
|
|
repeat
|
|
TreeWalkNext(walkState, walkRes);
|
|
if walkRes <> nil then
|
|
writeln(walkRes^.data^.stringdata);
|
|
until walkRes = nil;
|
|
|
|
|
|
|
|
for i := 1 to 30 do
|
|
begin
|
|
str(i,k);
|
|
k := 'test' + k;
|
|
writeln('deleting ', k);
|
|
TreeDelete(t,k);
|
|
end;
|
|
if t <> nil then
|
|
writeln('root: ', t^.key^)
|
|
else
|
|
writeln('root: nil');
|
|
PrintStringTree(t,1);
|
|
writeln('------------');
|
|
|
|
mem_dump;
|
|
end.
|