1 files changed, 141 insertions, 0 deletions
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.