summaryrefslogtreecommitdiff
path: root/packages/fcl-stl/src
diff options
context:
space:
mode:
Diffstat (limited to 'packages/fcl-stl/src')
-rw-r--r--packages/fcl-stl/src/garrayutils.pp254
-rw-r--r--packages/fcl-stl/src/gdeque.pp204
-rw-r--r--packages/fcl-stl/src/gmap.pp163
-rw-r--r--packages/fcl-stl/src/gpriorityqueue.pp141
-rw-r--r--packages/fcl-stl/src/gqueue.pp75
-rw-r--r--packages/fcl-stl/src/gset.pp423
-rw-r--r--packages/fcl-stl/src/gstack.pp73
-rw-r--r--packages/fcl-stl/src/gutil.pp39
-rw-r--r--packages/fcl-stl/src/gvector.pp173
9 files changed, 1545 insertions, 0 deletions
diff --git a/packages/fcl-stl/src/garrayutils.pp b/packages/fcl-stl/src/garrayutils.pp
new file mode 100644
index 0000000000..f9773b63db
--- /dev/null
+++ b/packages/fcl-stl/src/garrayutils.pp
@@ -0,0 +1,254 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit garrayutils;
+
+interface
+
+const MaxDepth=60;
+const InsertSortThreshold=16;
+
+{TCompare is comparing class, which should have class method c(a,b:TValue):boolean, which returns true if a is less than b}
+type
+ generic TOrderingArrayUtils<TArr, Tvalue, TCompare>=class
+ private
+ class procedure Sortrange(var Arr:TArr; Start,Fin,d:SizeUInt);
+ class procedure HeapSort(var Arr:TArr; Start,Fin:SizeUInt);
+ class procedure InsertSort(var Arr:TArr; Start,Fin:SizeUInt);
+ class function Left(a:SizeUInt):SizeUInt;inline;
+ class function Right(a:SizeUInt):SizeUInt;inline;
+ class procedure Heapify(var Arr: TArr; Position:SizeUInt; Start,Fin:SizeUInt);
+ class function Parent(a:SizeUInt):SizeUInt;inline;
+ public
+ class procedure Sort(var Arr: TArr; size:SizeUInt);
+ class function NextPermutation(var Arr: TArr; size:SizeUInt):boolean;
+ end;
+
+ generic TArrayUtils<TArr, Tvalue>=class
+ public
+ class procedure RandomShuffle(Arr: TArr; size: SizeUInt);
+ end;
+
+implementation
+
+class function TOrderingArrayUtils.Left(a:SizeUInt):SizeUInt;inline;
+begin
+ Left:=((a+1)shl 1)-1;
+end;
+
+class function TOrderingArrayUtils.Right(a:SizeUInt):SizeUInt;inline;
+begin
+ Right:=(a+1) shl 1;
+end;
+
+class function TOrderingArrayUtils.Parent(a:SizeUInt):SizeUInt;inline;
+begin
+ Parent:=(a-1)shr 1;
+end;
+
+class procedure TOrderingArrayUtils.Heapify(var Arr: TArr; Position:SizeUInt; Start,Fin:SizeUInt);
+var mpos,l,r:SizeUInt; temp:TValue;
+begin
+ while(true) do
+ begin
+ mpos:=Position;
+ l:=Left(Position-Start)+Start;
+ r:=Right(Position-Start)+Start;
+ if (l<Fin) AND (TCompare.c(Arr[mpos],Arr[l])) then
+ mpos:=l;
+ if (r<Fin) AND (TCompare.c(Arr[mpos],Arr[r])) then
+ mpos:=r;
+ if mpos = Position then break;
+
+ temp:=Arr[Position];
+ Arr[Position]:=Arr[mpos];
+ Arr[mpos]:=temp;
+ Position:=mpos;
+ end;
+end;
+
+class procedure TOrderingArrayUtils.Sort(var Arr:TArr; size:SizeUInt);inline;
+begin
+ Sortrange(Arr,0,size,0);
+ InsertSort(Arr,0,size);
+end;
+
+class procedure TOrderingArrayUtils.Sortrange(var Arr:TArr; Start,Fin,d:SizeUInt);
+var pivot,temp:Tvalue; i,j,k,l:SizeUInt;
+begin
+ if (Fin-Start) <= InsertSortThreshold then
+ begin
+ InsertSort(Arr,Start,Fin);
+ exit;
+ end;
+ if d>=maxdepth then
+ begin
+ HeapSort(Arr, Start, Fin);
+ exit;
+ end;
+{median of 3}
+ j:=Start;
+ k:=Fin-1;
+ l:=(Start+Fin)div 2;
+ if(TCompare.c(Arr[j],Arr[k])) and (TCompare.c(Arr[j],Arr[l])) then
+ begin
+ if(TCompare.c(Arr[k],Arr[l])) then
+ begin
+ temp:=Arr[k];
+ Arr[k]:=Arr[j];
+ Arr[j]:=temp;
+ end else
+ begin
+ temp:=Arr[l];
+ Arr[l]:=Arr[j];
+ Arr[j]:=temp;
+ end;
+ end
+ else if(TCompare.c(Arr[k],Arr[j])) and (TCompare.c(Arr[l],Arr[j])) then
+ begin
+ if(TCompare.c(Arr[l],Arr[k])) then
+ begin
+ temp:=Arr[k];
+ Arr[k]:=Arr[j];
+ Arr[j]:=temp;
+ end else
+ begin
+ temp:=Arr[l];
+ Arr[l]:=Arr[j];
+ Arr[j]:=temp;
+ end;
+ end;
+
+{partition}
+ pivot:=Arr[Start];
+
+ i:=Start-1;
+ j:=Fin;
+ repeat
+ repeat
+ dec(j);
+ until (not (TCompare.c(pivot,Arr[j])));
+
+
+ repeat
+ inc(i);
+ until (not (TCompare.c(Arr[i],pivot)));
+ if(i < j) then
+ begin
+ temp:=Arr[i];
+ Arr[i]:=Arr[j];
+ Arr[j]:=temp;
+ end;
+ until (i>=j);
+
+ Sortrange(Arr, Start, j+1, d+1);
+ Sortrange(Arr, j+1, Fin, d+1);
+end;
+
+class procedure TOrderingArrayUtils.InsertSort(var Arr:TArr; Start,Fin:SizeUInt);inline;
+var i,j:SizeUInt; temp:Tvalue;
+begin
+ for i:=Start+1 to Fin-1 do
+ begin
+ j:=i;
+ temp:=Arr[i];
+ while (j>0) and (TCompare.c(temp,Arr[j-1])) do
+ begin
+ Arr[j]:=Arr[j-1];
+ dec(j);
+ end;
+ Arr[j]:=temp;
+ end;
+end;
+
+class procedure TOrderingArrayUtils.HeapSort(var Arr: TArr; Start,Fin:SizeUInt);
+var i,cur,next,l,r,size:SizeUInt; temp:Tvalue;
+begin
+{buildHeap}
+ size:=Fin-Start;
+ for i:=((size div 2)-1) downto 0 do
+ Heapify(Arr, i+Start, Start, Fin);
+{bottomup HeapSort}
+ for i:=size-1 downto 1 do
+ begin
+ Fin:=Fin-1;
+ cur:=Start;
+ temp:=Arr[Start];
+ while(true) do
+ begin
+ l:=Left(cur-Start)+Start;
+ if l>=Fin then
+ break;
+ next:=l;
+ r:=Right(cur-Start)+Start;
+ if (r<Fin) AND (TCompare.c(Arr[l],Arr[r])) then
+ next:=r;
+ Arr[cur]:=Arr[next];
+ cur:=next;
+ end;
+ Arr[cur]:=temp;
+ temp:=Arr[i+Start];
+ Arr[i+Start]:=Arr[cur];
+ Arr[cur]:=temp;
+ l:=Parent(cur-Start)+Start;
+ while (cur <> 0) AND (TCompare.c(Arr[l],Arr[cur])) do
+ begin
+ temp:=Arr[cur];
+ Arr[cur]:=Arr[l];
+ Arr[l]:=temp;
+ cur:=l;
+ l:=Parent(cur-Start)+Start;
+ end;
+ end;
+end;
+
+class function TOrderingArrayUtils.NextPermutation(var Arr: TArr; size: SizeUInt):boolean;
+var i,f:SizeUInt; temp:TValue;
+begin
+ f := -1;
+ for i:=size-1 downto 1 do begin
+ if (TCompare.c(arr[i-1], arr[i])) then begin
+ f := i-1;
+ break;
+ end;
+ end;
+ if f = -1 then exit(false);
+ for i:=size-1 downto 1 do begin
+ if (TCompare.c(arr[f], arr[i])) then begin
+ temp:=arr[f]; arr[f] := arr[i]; arr[i] := temp;
+ break;
+ end;
+ end;
+ i:= size-1;
+ inc(f);
+ while (i > f) do begin
+ temp:=arr[f]; arr[f] := arr[i]; arr[i] := temp;
+ dec(i); inc(f);
+ end;
+ NextPermutation := true;
+end;
+
+class procedure TArrayUtils.RandomShuffle(Arr: TArr; size: SizeUInt);
+var i,r:SizeUInt; temp:Tvalue;
+begin
+ for i:=size-1 downto 1 do begin
+ r:=random(Int64(i));
+ temp:=Arr[r];
+ Arr[r]:=Arr[i];
+ Arr[i]:=temp;
+ end;
+end;
+
+
+end.
diff --git a/packages/fcl-stl/src/gdeque.pp b/packages/fcl-stl/src/gdeque.pp
new file mode 100644
index 0000000000..f83956f3c5
--- /dev/null
+++ b/packages/fcl-stl/src/gdeque.pp
@@ -0,0 +1,204 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gdeque;
+
+interface
+
+type
+ generic TDeque<T>=class
+ private
+ type
+ PT=^T;
+ TArr=array of T;
+ var
+ FData:TArr;
+ FDataSize:SizeUInt;
+ FCapacity:SizeUInt;
+ FStart:SizeUInt;
+ procedure SetValue(position:SizeUInt; value:T);inline;
+ function GetValue(position:SizeUInt):T;inline;
+ function GetMutable(position:SizeUInt):PT;inline;
+ procedure IncreaseCapacity();inline;
+ public
+ function Size():SizeUInt;inline;
+ constructor Create();
+ procedure PushBack(value:T);inline;
+ procedure PushFront(value:T);inline;
+ procedure PopBack();inline;
+ procedure PopFront();inline;
+ function Front():T;inline;
+ function Back():T;inline;
+ function IsEmpty():boolean;inline;
+ procedure Reserve(cap:SizeUInt);inline;
+ procedure Resize(cap:SizeUInt);inline;
+ procedure Insert(Position:SizeUInt; Value:T);inline;
+ procedure Erase(Position:SIzeUInt);inline;
+ property Items[i : SizeUInt]: T read GetValue write SetValue; default;
+ property Mutable[i : SizeUInt]:PT read GetMutable;
+end;
+
+implementation
+
+constructor TDeque.Create();
+begin
+ FDataSize:=0;
+ FCapacity:=0;
+ FStart:=0;
+end;
+
+function TDeque.Size():SizeUInt;inline;
+begin
+ Size:=FDataSize;
+end;
+
+function TDeque.IsEmpty():boolean;inline;
+begin
+ if Size()=0 then
+ IsEmpty:=true
+ else
+ IsEmpty:=false;
+end;
+
+procedure TDeque.PushBack(value:T);inline;
+begin
+ if(FDataSize=FCapacity) then
+ IncreaseCapacity;
+ FData[(FStart+FDataSize)mod FCapacity]:=value;
+ inc(FDataSize);
+end;
+
+procedure TDeque.PopFront();inline;
+begin
+ if(FDataSize>0) then
+ begin
+ inc(FStart);
+ dec(FDataSize);
+ if(FStart=FCapacity) then
+ FStart:=0;
+ end;
+end;
+
+procedure TDeque.PopBack();inline;
+begin
+ if(FDataSize>0) then
+ dec(FDataSize);
+end;
+
+procedure TDeque.PushFront(value:T);inline;
+begin
+ if(FDataSize=FCapacity) then
+ IncreaseCapacity;
+ if(FStart=0) then
+ FStart:=FCapacity-1
+ else
+ dec(FStart);
+ FData[FStart]:=value;
+ inc(FDataSize);
+end;
+
+function TDeque.Front():T;inline;
+begin
+ Assert(size > 0, 'Accessing empty deque');
+ Front:=FData[FStart];
+end;
+
+function TDeque.Back():T;inline;
+begin
+ Assert(size > 0, 'Accessing empty deque');
+ Back:=FData[(FStart+FDataSize-1)mod FCapacity];
+end;
+
+procedure TDeque.SetValue(position:SizeUInt; value:T);inline;
+begin
+ Assert(position < size, 'Deque access out of range');
+ FData[(FStart+position)mod FCapacity]:=value;
+end;
+
+function TDeque.GetValue(position:SizeUInt):T;inline;
+begin
+ Assert(position < size, 'Deque access out of range');
+ GetValue:=FData[(FStart+position) mod FCapacity];
+end;
+
+function TDeque.GetMutable(position:SizeUInt):PT;inline;
+begin
+ Assert(position < size, 'Deque access out of range');
+ GetMutable:=@FData[(FStart+position) mod FCapacity];
+end;
+
+procedure TDeque.IncreaseCapacity;inline;
+var i,OldEnd:SizeUInt;
+begin
+ OldEnd:=FCapacity;
+ if(FCapacity=0) then
+ FCapacity:=1
+ else
+ FCapacity:=FCapacity*2;
+ SetLength(FData, FCapacity);
+ if (FStart>0) then
+ for i:=0 to FStart-1 do
+ FData[OldEnd+i]:=FData[i];
+end;
+
+procedure TDeque.Reserve(cap:SizeUInt);inline;
+var i,OldEnd:SizeUInt;
+begin
+ if(cap<FCapacity) then
+ exit
+ else if(cap<=2*FCapacity) then
+ IncreaseCapacity
+ else
+ begin
+ OldEnd:=FCapacity;
+ FCapacity:=cap;
+ SetLength(FData, FCapacity);
+ if FStart > 0 then
+ for i:=0 to FStart-1 do
+ FData[OldEnd+i]:=FData[i];
+ end;
+end;
+
+procedure TDeque.Resize(cap:SizeUInt);inline;
+begin
+ Reserve(cap);
+ FDataSize:=cap;
+end;
+
+procedure TDeque.Insert(Position:SizeUInt; Value: T);inline;
+var i:SizeUInt;
+begin
+ pushBack(Value);
+ for i:=Size-1 downto Position+1 do
+ begin
+ Items[i]:=Items[i-1];
+ end;
+ Items[Position]:=Value;
+end;
+
+procedure TDeque.Erase(Position:SizeUInt);inline;
+var i:SizeUInt;
+begin
+ if Position <= Size then
+ begin
+ for i:=Position to Size-2 do
+ begin
+ Items[i]:=Items[i+1];
+ end;
+ popBack();
+ end;
+end;
+
+
+end.
diff --git a/packages/fcl-stl/src/gmap.pp b/packages/fcl-stl/src/gmap.pp
new file mode 100644
index 0000000000..fb64db26b5
--- /dev/null
+++ b/packages/fcl-stl/src/gmap.pp
@@ -0,0 +1,163 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gmap;
+
+interface
+
+uses gset;
+
+type
+ generic TMapCompare<TPair, TKeyCompare>=class
+ class function c(a,b :TPair):boolean;
+ end;
+
+ generic TMap<TKey, TValue, TCompare>=class
+ public
+ type
+ TPair=record
+ Value:TValue;
+ Key:TKey;
+ end;
+ TMCompare = specialize TMapCompare<TPair, TCompare>;
+ TMSet = specialize TSet<TPair, TMCompare>;
+ PTValue = ^TValue;
+ PTPair = ^TPair;
+ var
+ private
+ FSet:TMSet;
+ public
+ function Find(key:TKey):TMSet.PNode;inline;
+ function FindLess(key:TKey):TMSet.PNode;inline;
+ function FindLessEqual(key:TKey):TMSet.PNode;inline;
+ function FindGreater(key:TKey):TMSet.PNode;inline;
+ function FindGreaterEqual(key:TKey):TMSet.PNode;inline;
+ function GetValue(key:TKey):TValue;inline;
+ procedure Insert(key:TKey; value:TValue);inline;
+ function Min:TMSet.PNode;inline;
+ function Max:TMSet.PNode;inline;
+ function Next(x:TMSet.PNode):TMSet.PNode;inline;
+ function Prev(x:TMSet.PNode):TMSet.PNode;inline;
+ procedure Delete(key:TKey);inline;
+ function Size:SizeUInt;inline;
+ function IsEmpty:boolean;inline;
+ constructor Create;
+ destructor Destroy;override;
+ property Items[i : TKey]: TValue read GetValue write Insert; default;
+ end;
+
+implementation
+
+class function TMapCompare.c(a,b: TPair):boolean;
+begin
+ c:= TKeyCompare.c(a.Key, b.Key);
+end;
+
+constructor TMap.Create;
+begin
+ FSet:=TMSet.Create;
+end;
+
+destructor TMap.Destroy;
+begin
+ FSet.Destroy;
+end;
+
+procedure TMap.Delete(key:TKey);inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ FSet.Delete(Pair);
+end;
+
+function TMap.Find(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ Find:=FSet.Find(Pair);
+end;
+
+function TMap.FindLess(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ FindLess:=FSet.FindLess(Pair);
+end;
+
+function TMap.FindLessEqual(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ FindLessEqual:=FSet.FindLessEqual(Pair);
+end;
+
+function TMap.FindGreater(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ FindGreater:=FSet.FindGreater(Pair);
+end;
+
+function TMap.FindGreaterEqual(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ FindGreaterEqual:=FSet.FindGreaterEqual(Pair);
+end;
+
+function TMap.GetValue(key:TKey):TValue;inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ GetValue:=FSet.Find(Pair)^.Data.Value;
+end;
+
+procedure TMap.Insert(key:TKey; value:TValue);inline;
+var Pair:TPair;
+begin
+ Pair.Key:=key;
+ FSet.Insert(Pair)^.Data.Value := value;
+end;
+
+function TMap.Min:TMSet.PNode;inline;
+begin
+ Min:=FSet.Min;
+end;
+
+function TMap.Max:TMSet.PNode;inline;
+begin
+ Max:=FSet.Max;
+end;
+
+function TMap.Next(x:TMSet.PNode):TMSet.PNode;inline;
+begin
+ Next:=FSet.Next(x);
+end;
+
+function TMap.Prev(x:TMSet.PNode):TMSet.PNode;inline;
+begin
+ Prev:=FSet.Prev(x);
+end;
+
+function TMap.Size:SizeUInt;inline;
+begin
+ Size:=FSet.Size;
+end;
+
+function TMap.IsEmpty:boolean;inline;
+begin
+ IsEmpty:=FSet.IsEmpty;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gpriorityqueue.pp b/packages/fcl-stl/src/gpriorityqueue.pp
new file mode 100644
index 0000000000..7aa3d32cbc
--- /dev/null
+++ b/packages/fcl-stl/src/gpriorityqueue.pp
@@ -0,0 +1,141 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gpriorityqueue;
+
+interface
+
+uses gvector;
+
+{TCompare is comparing class, which should have class method c(a,b:T):boolean, which returns true is a is less than b}
+
+type
+ generic TPriorityQueue<T, TCompare>=class
+ private
+ type
+ TContainer=specialize TVector<T>;
+ var
+ FData:TContainer;
+
+ procedure PushUp(position:SizeUInt);
+ function Left(a:SizeUInt):SizeUInt;inline;
+ function Right(a:SizeUInt):SizeUInt;inline;
+ procedure Heapify(position:SizeUInt);
+ function Parent(a:SizeUInt):SizeUInt;inline;
+ public
+ constructor Create;
+ destructor Destroy;override;
+ function Top:T;inline;
+ procedure Pop;inline;
+ procedure Push(value:T);inline;
+ function Size:SizeUInt;inline;
+ function IsEmpty:boolean;inline;
+ end;
+
+implementation
+
+constructor TPriorityQueue.Create;
+begin
+ FData:=TContainer.Create;
+end;
+
+destructor TPriorityQueue.Destroy;
+begin;
+ FData.Destroy;
+end;
+
+function TPriorityQueue.Size:SizeUInt;inline;
+begin
+ Size:=FData.Size;
+end;
+
+function TPriorityQueue.IsEmpty:boolean;inline;
+begin
+ IsEmpty:=FData.Size=0;
+end;
+
+function TPriorityQueue.Top:T;inline;
+begin
+ Top:=FData[0];
+end;
+
+procedure TPriorityQueue.Pop;inline;
+begin
+ if not IsEmpty then begin
+ FData[0]:=FData.back;
+ FData.PopBack;
+ Heapify(0);
+ end;
+end;
+
+procedure TPriorityQueue.PushUp(position:SizeUInt);
+var np:SizeUInt; temp:T;
+begin
+ while(position>0) do
+ begin
+ np := Parent(position);
+ if(TCompare.c(FData[np],FData[position])) then
+ begin
+ temp:=FData[np];
+ FData[np]:=FData[position];
+ FData[position]:=temp;
+ position:=np;
+ end else
+ break;
+ end;
+end;
+
+procedure TPriorityQueue.Push(value:T);inline;
+begin
+ FData.PushBack(value);
+ PushUp(FData.Size-1);
+end;
+
+function TPriorityQueue.Left(a:SizeUInt):SizeUInt;inline;
+begin
+ Left:=((a+1)shl 1)-1;
+end;
+
+function TPriorityQueue.Right(a:SizeUInt):SizeUInt;inline;
+begin
+ Right:=(a+1) shl 1;
+end;
+
+function TPriorityQueue.Parent(a:SizeUInt):SizeUInt;inline;
+begin
+ Parent:=(a-1)shr 1;
+end;
+
+procedure TPriorityQueue.Heapify(position:SizeUInt);
+var mpos,l,r:SizeUInt; temp:T;
+begin
+ while(true) do
+ begin
+ mpos:=position;
+ l:=Left(position);
+ r:=Right(position);
+ if (l<FData.Size) AND (TCompare.c(FData[mpos],FData[l])) then
+ mpos:=l;
+ if (r<FData.Size) AND (TCompare.c(FData[mpos],FData[r])) then
+ mpos:=r;
+ if mpos = position then break;
+
+ temp:=FData[position];
+ FData[position]:=FData[mpos];
+ FData[mpos]:=temp;
+ position:=mpos;
+ end;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gqueue.pp b/packages/fcl-stl/src/gqueue.pp
new file mode 100644
index 0000000000..a56aef4e47
--- /dev/null
+++ b/packages/fcl-stl/src/gqueue.pp
@@ -0,0 +1,75 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gqueue;
+
+interface
+
+uses gdeque;
+
+type
+ generic TQueue<T>=class
+ private
+ type
+ TContainer = specialize TDeque<T>;
+ var
+ FData:TContainer;
+ public
+ procedure Push(value:T);inline;
+ procedure Pop();inline;
+ function Front():T;inline;
+ function Size():SizeUInt;inline;
+ function IsEmpty():boolean;inline;
+ constructor Create;
+ destructor Destroy;override;
+end;
+
+implementation
+
+constructor TQueue.Create;
+begin
+ FData:=TContainer.Create;
+end;
+
+destructor TQueue.Destroy;
+begin
+ FData.Destroy;
+end;
+
+procedure TQueue.Push(value:T);inline;
+begin
+ FData.PushBack(value);
+end;
+
+procedure TQueue.Pop();inline;
+begin
+ FData.PopFront;
+end;
+
+function TQueue.Front:T;inline;
+begin
+ Front:=FData.Front;
+end;
+
+function TQueue.Size:SizeUInt;inline;
+begin
+ Size:=FData.Size;
+end;
+
+function TQueue.IsEmpty:boolean;inline;
+begin
+ IsEmpty:=FData.IsEmpty;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gset.pp b/packages/fcl-stl/src/gset.pp
new file mode 100644
index 0000000000..01f2937644
--- /dev/null
+++ b/packages/fcl-stl/src/gset.pp
@@ -0,0 +1,423 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gset;
+
+interface
+
+const RED=true;
+const BLACK=false;
+
+type
+ generic TSet<T, TCompare>=class
+ public
+ type
+ PNode=^Node;
+ Node=record
+ Data:T;
+ Left,Right:PNode;
+ Parent:PNode;
+ Color:boolean;
+ end;
+ var
+ private
+ FBase:PNode;
+ FSize:SizeUInt;
+
+ function CreateNode(Data:T):PNode;inline;
+ procedure DestroyNodeAndChilds(nod:PNode);
+ procedure DestroyNode(nod:PNode);
+ function RotateRight(nod:PNode):PNode;inline;
+ function RotateLeft(nod:PNode):PNode;inline;
+ procedure FlipColors(nod:PNode);inline;
+ function IsRed(nod:PNode):boolean;inline;
+ function Insert(value:T; nod:PNode; var position:PNode):PNode;
+ function FixUp(nod:PNode):PNode;inline;
+ function MoveRedLeft(nod:PNode):PNode;inline;
+ function MoveRedRight(nod:PNode):PNode;inline;
+ function DeleteMin(nod:PNode):PNode;
+ function Delete(value:T; nod:PNode):PNode;
+ function Min(nod:PNode):PNode;inline;
+
+ public
+ function Find(value:T):PNode;inline;
+ function FindLess(value:T):PNode;inline;
+ function FindLessEqual(value:T):PNode;inline;
+ function FindGreater(value:T):PNode;inline;
+ function FindGreaterEqual(value:T):PNode;inline;
+ function Insert(value:T):PNode;inline;
+ function Min:PNode;inline;
+ function Max:PNode;inline;
+ function Next(x:PNode):PNode;inline;
+ function Prev(x:PNode):PNode;inline;
+ procedure Delete(value:T);inline;
+ public constructor Create;
+ public destructor Destroy;override;
+ function Size:SizeUInt;
+ function IsEmpty:boolean;
+ end;
+
+implementation
+
+constructor TSet.Create;
+begin
+ FBase:=nil;
+ FSize:=0;
+end;
+
+destructor TSet.Destroy;
+begin
+ DestroyNodeAndChilds(FBase);
+end;
+
+function TSet.Size:SizeUInt;
+begin
+ Size:=FSize;
+end;
+
+function TSet.IsEmpty:boolean;
+begin
+ IsEmpty := FSize=0;
+end;
+
+procedure TSet.DestroyNodeAndChilds(nod:PNode);
+begin
+ if nod = nil then exit;
+ DestroyNodeAndChilds(nod^.left);
+ DestroyNodeAndChilds(nod^.right);
+ DestroyNode(nod);
+end;
+
+procedure TSet.DestroyNode(nod:PNode);
+begin
+ Finalize(nod^.Data);
+ dispose(nod);
+ dec(FSize);
+end;
+
+function TSet.CreateNode(Data:T):PNode;inline;
+var temp:PNode;
+begin
+ temp:=new(PNode);
+ Initialize(temp^.Data);
+ temp^.Data:=Data;
+ temp^.Left:=nil;
+ temp^.Right:=nil;
+ temp^.Parent:=nil;
+ temp^.Color:=RED;
+ inc(FSize);
+ CreateNode:=temp;
+end;
+
+function TSet.RotateRight(nod:PNode):PNode;inline;
+var temp:PNode;
+begin
+ temp:=nod^.Left;
+
+ temp^.Parent:=nod^.Parent;
+ nod^.Parent:=temp;
+
+ nod^.Left:=temp^.Right;
+ temp^.Right:=nod;
+
+ if(nod^.Left<>nil) then nod^.Left^.Parent:=nod;
+
+ temp^.Color:=nod^.Color;
+ nod^.Color:=RED;
+ exit(temp);
+end;
+
+function TSet.RotateLeft(nod:PNode):PNode;inline;
+var temp:PNode;
+begin
+ temp:=nod^.Right;
+
+ temp^.Parent:=nod^.Parent;
+ nod^.Parent:=temp;
+
+ nod^.Right:=temp^.Left;
+ temp^.Left:=nod;
+
+ if(nod^.Right<>nil) then nod^.Right^.Parent:=nod;
+
+ temp^.Color:=nod^.Color;
+ nod^.Color:=RED;
+ exit(temp);
+end;
+
+procedure TSet.FlipColors(nod:PNode);inline;
+begin
+ nod^.Color:= not nod^.Color;
+ nod^.Left^.Color := not nod^.Left^.Color;
+ nod^.Right^.Color := not nod^.Right^.Color;
+end;
+
+
+function TSet.FixUp(nod:PNode):PNode;inline;
+begin
+ if(IsRed(nod^.Right)) and (not IsRed(nod^.Left)) then nod := rotateLeft(nod);
+ if(IsRed(nod^.Left)) and (IsRed(nod^.Left^.Left)) then nod := rotateRight(nod);
+ if(IsRed(nod^.Right)) and (IsRed(nod^.Left)) then flipColors(nod);
+ FixUp:=nod;
+end;
+
+function TSet.MoveRedLeft(nod:PNode):PNode;inline;
+begin
+ flipColors(nod);
+ if (IsRed(nod^.Right^.Left)) then begin
+ nod^.Right := rotateRight(nod^.Right);
+ nod := rotateLeft(nod);
+ flipColors(nod);
+ end;
+ MoveRedLeft:=nod;
+end;
+
+function TSet.MoveRedRight(nod:PNode):PNode;inline;
+begin
+ flipColors(nod);
+ if (IsRed(nod^.Left^.Left)) then begin
+ nod := rotateRight(nod);
+ flipColors(nod);
+ end;
+ MoveRedRight:=nod;
+end;
+
+function TSet.DeleteMin(nod:PNode):PNode;
+begin
+ if (nod^.Left = nil) then begin
+ DestroyNode(nod);
+ exit(nil);
+ end;
+
+ if ((not IsRed(nod^.Left)) and (not IsRed(nod^.Left^.Left))) then nod := MoveRedLeft(nod);
+
+ nod^.Left := DeleteMin(nod^.Left);
+
+ exit(FixUp(nod));
+end;
+
+function TSet.Delete(value:T; nod:PNode):PNode;
+begin
+ if (TCompare.c(value, nod^.Data)) then begin
+ if (nod^.Left=nil) then exit(nod);
+ if ((not IsRed(nod^.Left)) and ( not IsRed(nod^.Left^.Left))) then
+ nod := MoveRedLeft(nod);
+ nod^.Left := Delete(value, nod^.Left);
+ end
+ else begin
+ if (IsRed(nod^.Left)) then begin
+ nod := rotateRight(nod);
+ end;
+ if ((not TCompare.c(value,nod^.Data)) and (not TCompare.c(nod^.Data,value)) and (nod^.Right = nil)) then
+ begin
+ DestroyNode(nod);
+ exit(nil);
+ end;
+ if (nod^.Right=nil) then exit(nod);
+ if ((not IsRed(nod^.Right)) and (not IsRed(nod^.Right^.Left))) then nod := MoveRedRight(nod);
+ if ((not TCompare.c(value,nod^.Data)) and (not TCompare.c(nod^.Data,value))) then begin
+ nod^.Data := Min(nod^.Right)^.Data;
+ nod^.Right := DeleteMin(nod^.Right);
+ end
+ else nod^.Right := Delete(value, nod^.Right);
+ end;
+ exit(FixUp(nod));
+end;
+
+procedure TSet.Delete(value:T);inline;
+begin
+ if(FBase<>nil) then FBase:=Delete(value, FBase);
+ if(FBase<>nil) then FBase^.Color:=BLACK;
+end;
+
+
+function TSet.Find(value:T):PNode;inline;
+var x:PNode;
+begin
+ x:=FBase;
+ while(x <> nil) do begin
+ if(TCompare.c(value,x^.Data)) then x:=x^.Left
+ else if(TCompare.c(x^.Data,value)) then x:=x^.Right
+ else exit(x);
+ end;
+ exit(nil);
+end;
+
+function TSet.FindLess(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+ x:=nil;
+ cur:=FBase;
+ while (cur <> nil) do begin
+ if (TCompare.c(cur^.Data, value)) then
+ begin
+ x:=cur;
+ cur:=cur^.right;
+ end else
+ cur:=cur^.left;
+ end;
+ FindLess:=x;
+end;
+
+function TSet.FindLessEqual(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+ x:=nil;
+ cur:=FBase;
+ while (cur <> nil) do begin
+ if (not TCompare.c(value, cur^.data)) then
+ begin
+ x:=cur;
+ cur:=cur^.right;
+ end else
+ cur:=cur^.left;
+ end;
+ FindLessEqual:=x;
+end;
+
+function TSet.FindGreater(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+ x:=nil;
+ cur:=FBase;
+ while (cur <> nil) do begin
+ if (TCompare.c(value, cur^.Data)) then
+ begin
+ x:=cur;
+ cur:=cur^.left;
+ end else
+ cur:=cur^.right;
+ end;
+ FindGreater:=x;
+end;
+
+function TSet.FindGreaterEqual(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+ x:=nil;
+ cur:=FBase;
+ while (cur <> nil) do begin
+ if (not TCompare.c(cur^.Data, value)) then
+ begin
+ x:=cur;
+ cur:=cur^.left;
+ end else
+ cur:=cur^.right;
+ end;
+ FindGreaterEqual:=x;
+end;
+
+function TSet.Insert(value:T):PNode;inline;
+var position:PNode;
+begin
+ FBase:=Insert(value, FBase, position);
+ FBase^.Color:=BLACK;
+ Insert:=position;
+end;
+
+function TSet.Insert(value:T; nod:PNode; var position:PNode):PNode;
+begin
+ if(nod=nil) then begin
+ nod:=CreateNode(value);
+ position:=nod;
+ exit(nod);
+ end;
+ if(TCompare.c(value,nod^.Data)) then begin
+ nod^.Left:=Insert(value, nod^.Left, position);
+ nod^.Left^.Parent:=nod;
+ end
+ else if TCompare.c(nod^.Data,value) then begin
+ nod^.Right:=Insert(value, nod^.Right, position);
+ nod^.Right^.Parent:=nod;
+ end
+ else begin
+ position:=nod;
+ exit(nod);
+ end;
+
+ if(IsRed(nod^.Right)) and (not IsRed(nod^.Left)) then nod := rotateLeft(nod);
+ if(IsRed(nod^.Left)) and (IsRed(nod^.Left^.Left)) then nod := rotateRight(nod);
+ if(IsRed(nod^.Right)) and (IsRed(nod^.Left)) then flipColors(nod);
+
+ Insert:=nod;
+end;
+
+function TSet.IsRed(nod:PNode):boolean;inline;
+begin
+ if(nod=nil) then exit(false);
+ exit(nod^.Color);
+end;
+
+function TSet.Min(nod:PNode):PNode;inline;
+var temp:PNode;
+begin
+ temp:=nod;
+ while(temp^.Left<>nil) do temp:=temp^.Left;
+ exit(temp);
+end;
+
+function TSet.Min:PNode;inline;
+begin
+ if FBase=nil then exit(nil);
+ Min:=Min(FBase);
+end;
+
+function TSet.Max:PNode;inline;
+var temp:PNode;
+begin
+ if FBase=nil then exit(nil);
+ temp:=FBase;
+ while(temp^.Right<>nil) do temp:=temp^.Right;
+ exit(temp);
+end;
+
+function TSet.Next(x:PNode):PNode;inline;
+var temp:PNode;
+begin
+ if(x=nil) then exit(nil);
+ if(x^.Right<>nil) then begin
+ temp:=x^.Right;
+ while(temp^.Left<>nil) do temp:=temp^.Left;
+ end
+ else begin
+ temp:=x;
+ while(true) do begin
+ if(temp^.Parent=nil) then begin temp:=temp^.Parent; break; end;
+ if(temp^.Parent^.Left=temp) then begin temp:=temp^.Parent; break; end;
+ temp:=temp^.Parent;
+ end;
+ end;
+ exit(temp);
+end;
+
+function TSet.Prev(x:PNode):PNode;inline;
+var temp:PNode;
+begin
+ if(x=nil) then exit(nil);
+ if(x^.Left<>nil) then begin
+ temp:=x^.Left;
+ while(temp^.Right<>nil) do temp:=temp^.Right;
+ end
+ else begin
+ temp:=x;
+ while(true) do begin
+ if(temp^.Parent=nil) then begin temp:=temp^.Parent; break; end;
+ if(temp^.Parent^.Right=temp) then begin temp:=temp^.Parent; break; end;
+ temp:=temp^.Parent;
+ end;
+ end;
+ exit(temp);
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gstack.pp b/packages/fcl-stl/src/gstack.pp
new file mode 100644
index 0000000000..2d5cfe4020
--- /dev/null
+++ b/packages/fcl-stl/src/gstack.pp
@@ -0,0 +1,73 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gstack;
+
+interface
+
+uses gvector;
+
+type
+ generic TStack<T>=class
+ private
+ type TContainer= specialize TVector<T>;
+ var FData:TContainer;
+ public
+ procedure Push(x:T);inline;
+ procedure Pop();inline;
+ function Top():T;inline;
+ function Size():longint;inline;
+ function IsEmpty():boolean;inline;
+ constructor Create;
+ destructor Destroy;override;
+end;
+
+implementation
+
+constructor TStack.Create;
+begin
+ FData:=TContainer.Create;
+end;
+
+destructor TStack.Destroy;
+begin
+ FData.Destroy;
+end;
+
+procedure TStack.Push(x:T);inline;
+begin
+ FData.PushBack(x);
+end;
+
+procedure TStack.Pop;inline;
+begin
+ FData.PopBack;
+end;
+
+function TStack.Top:T;inline;
+begin
+ Top:=FData.Back;
+end;
+
+function TStack.Size:longint;inline;
+begin
+ Size:=FData.Size;
+end;
+
+function TStack.IsEmpty:boolean;inline;
+begin
+ IsEmpty:=FData.IsEmpty;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gutil.pp b/packages/fcl-stl/src/gutil.pp
new file mode 100644
index 0000000000..f653940f2b
--- /dev/null
+++ b/packages/fcl-stl/src/gutil.pp
@@ -0,0 +1,39 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gutil;
+
+interface
+
+type generic TLess<T>=class
+ class function c(a,b:T):boolean;inline;
+end;
+
+type generic TGreater<T>=class
+ class function c(a,b:T):boolean;inline;
+end;
+
+implementation
+
+class function TLess.c(a,b:T):boolean;inline;
+begin
+ c:=a<b;
+end;
+
+class function TGreater.c(a,b:T):boolean;inline;
+begin
+ c:=b<a;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gvector.pp b/packages/fcl-stl/src/gvector.pp
new file mode 100644
index 0000000000..96fb6bce76
--- /dev/null
+++ b/packages/fcl-stl/src/gvector.pp
@@ -0,0 +1,173 @@
+{
+ This file is part of the Free Pascal FCL library.
+ BSD parts (c) 2011 Vlado Boza
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gvector;
+
+interface
+
+type
+ generic TVector<T>=class
+ private
+ type
+ PT=^ T;
+ TArr=array of T;
+ var
+ FCapacity:SizeUInt;
+ FDataSize:SizeUInt;
+ FData:TArr;
+
+ procedure SetValue(Position:SizeUInt; Value:T);inline;
+ function GetValue(Position:SizeUInt):T;inline;
+ function GetMutable(Position:SizeUInt):PT;inline;
+ procedure IncreaseCapacity;inline;
+ public
+ constructor Create;
+ function Size:SizeUInt;inline;
+ procedure PushBack(Value:T);inline;
+ procedure PopBack;inline;
+ function IsEmpty:boolean;inline;
+ procedure Insert(Position:SizeUInt; Value:T);inline;
+ procedure Erase(Position:SizeUInt);inline;
+ procedure Clear;inline;
+ function Front:T;inline;
+ function Back:T;inline;
+ procedure Reserve(Num:SizeUInt);inline;
+ procedure Resize(Num:SizeUInt);inline;
+
+ property Items[i : SizeUInt]: T read getValue write setValue; default;
+ property Mutable[i : SizeUInt]: PT read getMutable;
+end;
+
+implementation
+
+constructor TVector.Create();
+begin
+ FCapacity:=0;
+ FDataSize:=0;
+end;
+
+procedure TVector.SetValue(Position:SizeUInt; Value:T);inline;
+begin
+ Assert(position < size, 'Vector position out of range');
+ FData[Position]:=Value;
+end;
+
+function TVector.GetValue(Position:SizeUInt):T;inline;
+begin
+ Assert(position < size, 'Vector position out of range');
+ GetValue:=FData[Position];
+end;
+
+function TVector.GetMutable(Position:SizeUInt):PT;inline;
+begin
+ Assert(position < size, 'Vector position out of range');
+ GetMutable:=@FData[Position];
+end;
+
+function TVector.Front():T;inline;
+begin
+ Assert(size > 0, 'Accessing element of empty vector');
+ Front:=FData[0];
+end;
+
+function TVector.Back():T;inline;
+begin
+ Assert(size > 0, 'Accessing element of empty vector');
+ Back:=FData[FDataSize-1];
+end;
+
+function TVector.Size():SizeUInt;inline;
+begin
+ Size:=FDataSize;
+end;
+
+function TVector.IsEmpty():boolean;inline;
+begin
+ if Size()=0 then
+ IsEmpty:=true
+ else
+ IsEmpty:=false;
+end;
+
+procedure TVector.PushBack(Value:T);inline;
+begin
+ if FDataSize=FCapacity then
+ IncreaseCapacity;
+ FData[FDataSize]:=Value;
+ inc(FDataSize);
+end;
+
+procedure TVector.IncreaseCapacity();inline;
+begin
+ if FCapacity=0 then
+ FCapacity:=1
+ else
+ FCapacity:=FCapacity*2;
+ SetLength(FData, FCapacity);
+end;
+
+procedure TVector.PopBack();inline;
+begin
+ if FDataSize>0 then
+ FDataSize:=FDataSize-1;
+end;
+
+procedure TVector.Insert(Position:SizeUInt; Value: T);inline;
+var i:SizeUInt;
+begin
+ pushBack(Value);
+ for i:=Size-1 downto Position+1 do
+ begin
+ FData[i]:=FData[i-1];
+ end;
+ FData[Position]:=Value;
+end;
+
+procedure TVector.Erase(Position:SizeUInt);inline;
+var i:SizeUInt;
+begin
+ if Position <= Size then
+ begin
+ for i:=Position to Size-2 do
+ begin
+ FData[i]:=FData[i+1];
+ end;
+ popBack();
+ end;
+end;
+
+procedure TVector.Clear;inline;
+begin
+ FDataSize:=0;
+end;
+
+procedure TVector.Reserve(Num:SizeUInt);inline;
+begin
+ if(Num < FCapacity) then
+ exit
+ else if(Num <= 2*FCapacity) then
+ IncreaseCapacity
+ else begin
+ SetLength(FData, Num);
+ FCapacity:=Num;
+ end;
+end;
+
+procedure TVector.Resize(Num:SizeUInt);inline;
+begin
+ Reserve(Num);
+ FDataSize:=Num;
+end;
+
+end.