Skip to content

Commit bb579b1

Browse files
marat1961marat1961
committedJul 16, 2023
added TSplayTree: Self-adjusting search trees
1 parent df2d6b0 commit bb579b1

File tree

1 file changed

+310
-1
lines changed

1 file changed

+310
-1
lines changed
 

‎src/Oz.SGL.Collections.pas

+310-1
Original file line numberDiff line numberDiff line change
@@ -544,7 +544,6 @@ TIterator = record
544544

545545
private
546546
FList: TCustomForwardList;
547-
FNodeMeta: TsgItemMeta;
548547
function GetRegion: PSegmentedRegion; inline;
549548
function GetCount: Integer; inline;
550549
public
@@ -1040,6 +1039,74 @@ TsgSet<Key: record> = record
10401039

10411040
{$EndRegion}
10421041

1042+
{$Region 'TSegmentedAllocator: Segmented memory manager'}
1043+
1044+
TSegmentedAllocator<Value> = class
1045+
type
1046+
PValue = ^Value;
1047+
strict private
1048+
Fregion: PSegmentedRegion;
1049+
public
1050+
constructor Create(region: PSegmentedRegion);
1051+
destructor Destroy; override;
1052+
function Alloc: PValue; virtual;
1053+
end;
1054+
1055+
{$EndRegion}
1056+
1057+
{$Region 'TSplayTree: Self-adjusting search trees'}
1058+
1059+
// Follows "An implementation of top-down splaying"
1060+
// by D. Sleator <sleator@cs.cmu.edu> March 1992
1061+
TSplayTree<Key> = record
1062+
type
1063+
PNode = ^TNode;
1064+
TNode = record
1065+
left, right: PNode;
1066+
k: Key;
1067+
end;
1068+
TSplayMeta = record
1069+
allocator: TSegmentedAllocator<TNode>;
1070+
comparator: TCompareProc;
1071+
end;
1072+
private
1073+
meta: TSplayMeta;
1074+
Froot: PNode;
1075+
Fsize: Integer;
1076+
// Simple top down splay, not requiring i to be in the tree t.
1077+
function Splay(k: Key; t: PNode): PNode;
1078+
// Insert a key, allows duplicates
1079+
function Insert(const k: Key; t: PNode): PNode; overload;
1080+
// Deletes k from the tree if it's there
1081+
function Remove(k: Key; t: PNode): PNode; overload;
1082+
public
1083+
constructor From(const meta: TSplayMeta);
1084+
// Free memory
1085+
procedure Free;
1086+
// Insert a key, allows duplicates
1087+
function Insert(const k: Key): PNode; overload;
1088+
// Adds a key, if it is not present in the tree
1089+
function Add(k: Key): PNode;
1090+
// Deletes k from the tree if it's there
1091+
procedure Remove(k: Key); overload;
1092+
// Removes and returns the node with smallest key
1093+
function Pop: PNode;
1094+
// Find with splaying
1095+
function Find(k: Key): PNode;
1096+
// Find without splaying
1097+
function FindStatic(k: Key): PNode;
1098+
// Find max node
1099+
function MaxNode(t: PNode): PNode;
1100+
// Find min node
1101+
function MinNode(t: PNode): PNode;
1102+
// Returns root node
1103+
property root: PNode read Froot;
1104+
// Returns the number of elements
1105+
property size: Integer read Fsize;
1106+
end;
1107+
1108+
{$EndRegion}
1109+
10431110
{$Region 'TSharedRegion: Shared typed memory region'}
10441111

10451112
TSharedRegion = record
@@ -3835,6 +3902,248 @@ procedure TsgSet<Key>.UpdateValue(pnd: TsgCustomTree.PNode; pval: Pointer);
38353902

38363903
{$EndRegion}
38373904

3905+
{$Region 'TSegmentedAllocator<Value>'}
3906+
3907+
constructor TSegmentedAllocator<Value>.Create(region: PSegmentedRegion);
3908+
begin
3909+
Fregion := region;
3910+
end;
3911+
3912+
destructor TSegmentedAllocator<Value>.Destroy;
3913+
begin
3914+
Fregion.Free;
3915+
inherited;
3916+
end;
3917+
3918+
function TSegmentedAllocator<Value>.Alloc: PValue;
3919+
begin
3920+
Result := FRegion.AddItem;
3921+
end;
3922+
3923+
{$EndRegion}
3924+
3925+
{$Region 'TSplayTree<Key>'}
3926+
3927+
constructor TSplayTree<Key>.From(const meta: TSplayMeta);
3928+
begin
3929+
Self := Default(TSplayTree<Key>);
3930+
Self.meta := meta;
3931+
end;
3932+
3933+
procedure TSplayTree<Key>.Free;
3934+
begin
3935+
FreeAndNil(meta.allocator);
3936+
end;
3937+
3938+
function TSplayTree<Key>.Splay(k: Key; t: PNode): PNode;
3939+
var
3940+
n, l, r, y: PNode;
3941+
cmp: Integer;
3942+
begin
3943+
n := meta.allocator.Alloc;
3944+
l := n;
3945+
r := n;
3946+
repeat
3947+
cmp := meta.comparator(k, t.k);
3948+
if cmp < 0 then
3949+
begin
3950+
if t.left = nil then break;
3951+
if meta.comparator(k, t.left.k) < 0 then
3952+
begin
3953+
y := t.left; // rotate right
3954+
t.left := y.right;
3955+
y.right := t;
3956+
t := y;
3957+
if t.left = nil then break;
3958+
end;
3959+
r.left := t; // link right
3960+
r := t;
3961+
t := t.left;
3962+
end
3963+
else if cmp > 0 then
3964+
begin
3965+
if t.right = nil then break;
3966+
if meta.comparator(k, t.right.k) > 0 then
3967+
begin
3968+
y := t.right; // rotate left
3969+
t.right := y.left;
3970+
y.left := t;
3971+
t := y;
3972+
if t.right = nil then break;
3973+
end;
3974+
l.right := t; // link left
3975+
l := t;
3976+
t := t.right;
3977+
end
3978+
else break;
3979+
until False;
3980+
// assemble
3981+
l.right := t.left;
3982+
r.left := t.right;
3983+
t.left := n.right;
3984+
t.right := n.left;
3985+
Result := t;
3986+
end;
3987+
3988+
function TSplayTree<Key>.Insert(const k: Key): PNode;
3989+
begin
3990+
Inc(Fsize);
3991+
Froot := Insert(k, Froot);
3992+
Result := Froot;
3993+
end;
3994+
3995+
function TSplayTree<Key>.MaxNode(t: PNode): PNode;
3996+
begin
3997+
if t <> nil then
3998+
while t.right <> nil do t := t.right;
3999+
Result := t;
4000+
end;
4001+
4002+
function TSplayTree<Key>.MinNode(t: PNode): PNode;
4003+
begin
4004+
if t <> nil then
4005+
while t.left <> nil do t := t.left;
4006+
Result := t;
4007+
end;
4008+
4009+
function TSplayTree<Key>.Insert(const k: Key; t: PNode): PNode;
4010+
var
4011+
n: PNode;
4012+
cmp: Integer;
4013+
begin
4014+
n := meta.allocator.Alloc;
4015+
n.k := k;
4016+
if t = nil then
4017+
begin
4018+
n.left := nil;
4019+
n.right := nil;
4020+
exit(n);
4021+
end;
4022+
t := Splay(k, t);
4023+
cmp := meta.comparator(k, t.k);
4024+
if cmp < 0 then
4025+
begin
4026+
n.left := t.left;
4027+
n.right := t;
4028+
t.left := nil;
4029+
end
4030+
else if cmp >= 0 then
4031+
begin
4032+
n.right := t.right;
4033+
n.left := t;
4034+
t.right := nil;
4035+
end;
4036+
Result := n;
4037+
end;
4038+
4039+
function TSplayTree<Key>.Add(k: Key): PNode;
4040+
var
4041+
n, t: PNode;
4042+
cmp: Integer;
4043+
begin
4044+
n := meta.allocator.Alloc;
4045+
n.k := k;
4046+
if Froot = nil then
4047+
begin
4048+
n.left := nil;
4049+
n.right := nil;
4050+
Inc(Fsize);
4051+
Froot := n;
4052+
end;
4053+
t := Splay(k, Froot);
4054+
cmp := meta.comparator(k, t.k);
4055+
if cmp = 0 then
4056+
Froot := t
4057+
else
4058+
begin
4059+
if cmp < 0 then
4060+
begin
4061+
n.left := t.left;
4062+
n.right := t;
4063+
t.left := nil;
4064+
end
4065+
else if cmp > 0 then
4066+
begin
4067+
n.right := t.right;
4068+
n.left := t;
4069+
t.right := nil;
4070+
end;
4071+
Inc(Fsize);
4072+
Froot := n;
4073+
end;
4074+
Result := Froot;
4075+
end;
4076+
4077+
procedure TSplayTree<Key>.Remove(k: Key);
4078+
begin
4079+
Froot := Remove(k, Froot);
4080+
end;
4081+
4082+
function TSplayTree<Key>.Remove(k: Key; t: PNode): PNode;
4083+
var
4084+
x: PNode;
4085+
cmp: Integer;
4086+
begin
4087+
if t = nil then exit(nil);
4088+
t := Splay(k, t);
4089+
cmp := meta.comparator(k, t.k);
4090+
if cmp = 0 then
4091+
begin // found it
4092+
if t.left = nil then
4093+
x := t.right
4094+
else
4095+
begin
4096+
x := Splay(k, t.left);
4097+
x.right := t.right;
4098+
end;
4099+
Dec(Fsize);
4100+
exit(x);
4101+
end;
4102+
Result := t;
4103+
end;
4104+
4105+
function TSplayTree<Key>.Pop: PNode;
4106+
var
4107+
n: PNode;
4108+
begin
4109+
n := Froot;
4110+
if n <> nil then
4111+
begin
4112+
while n.left <> nil do
4113+
n := n.left;
4114+
Froot := Splay(n.k, Froot);
4115+
Froot := Remove(n.k, Froot);
4116+
exit(n);
4117+
end;
4118+
Result := nil;
4119+
end;
4120+
4121+
function TSplayTree<Key>.Find(k: Key): PNode;
4122+
begin
4123+
if Froot = nil then exit(Froot);
4124+
Froot := Splay(k, Froot);
4125+
if meta.comparator(k, Froot.k) <> 0 then
4126+
Result := nil
4127+
else
4128+
Result := Froot;
4129+
end;
4130+
4131+
function TSplayTree<Key>.FindStatic(k: Key): PNode;
4132+
var
4133+
n: PNode;
4134+
begin
4135+
n := Froot;
4136+
while n <> nil do
4137+
case meta.comparator(k, n.k) of
4138+
0: exit(n);
4139+
-1: n := n.left;
4140+
else n := n.right;
4141+
end;
4142+
Result := nil;
4143+
end;
4144+
4145+
{$EndRegion}
4146+
38384147
{$Region 'TSharedRegion'}
38394148

38404149
procedure TSharedRegion.Init(Meta: PsgItemMeta; Capacity: Cardinal);

0 commit comments

Comments
 (0)
Please sign in to comment.