diff --git a/src/shared/binheap.pas b/src/shared/binheap.pas
index 968c5f94221e63a73ced2a96a109eda6ff99daf0..e3ff3e742870f89fda244fd1b86152e35a1cfe67 100644 (file)
--- a/src/shared/binheap.pas
+++ b/src/shared/binheap.pas
-(* Copyright (C) DooM 2D:Forever Developers
+(* Copyright (C) Doom 2D: Forever Developers
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
+ * the Free Software Foundation, version 3 of the License ONLY.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
interface
interface
+(*
+ * CmpObjT: class that contains class methods:
+ * class function less (const[ref] a, b: KeyT): Boolean;
+ *)
type
type
- TBinaryHeapLessFn = function (a, b: TObject): Boolean;
-
- TBinaryHeapObj = class(TObject)
+ // WARNING! don't put structures into heap, use ponters or ids!
+ generic TBinaryHeapBase<ITP, CmpObjT> = class(TObject)
private
private
- elem: array of TObject;
+ elem: array of ITP;
elemUsed: Integer;
elemUsed: Integer;
- lessfn: TBinaryHeapLessFn;
private
procedure heapify (root: Integer);
public
private
procedure heapify (root: Integer);
public
- constructor Create (alessfn: TBinaryHeapLessFn);
+ constructor Create ();
destructor Destroy (); override;
procedure clear ();
destructor Destroy (); override;
procedure clear ();
- procedure insert (val: TObject);
+ procedure insert (val: ITP);
- function front (): TObject;
+ function front (): ITP;
procedure popFront ();
property count: Integer read elemUsed;
end;
procedure popFront ();
property count: Integer read elemUsed;
end;
+type
+ TBinHeapKeyIntLess = class
+ public
+ class function less (const a, b: Integer): Boolean; inline;
+ end;
+
+ TBinHeapKeyIntGreat = class
+ public
+ class function less (const a, b: Integer): Boolean; inline;
+ end;
+
+
+type
+ TBinaryHeapIntLess = specialize TBinaryHeapBase<Integer, TBinHeapKeyIntLess>;
+ TBinaryHeapIntGreat = specialize TBinaryHeapBase<Integer, TBinHeapKeyIntGreat>;
+
+
implementation
uses
implementation
uses
// ////////////////////////////////////////////////////////////////////////// //
// ////////////////////////////////////////////////////////////////////////// //
-constructor TBinaryHeapObj.Create (alessfn: TBinaryHeapLessFn);
+class function TBinHeapKeyIntLess.less (const a, b: Integer): Boolean; inline; begin result := (a < b); end;
+class function TBinHeapKeyIntGreat.less (const a, b: Integer): Boolean; inline; begin result := (a > b); end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TBinaryHeapBase.Create ();
begin
begin
- if not assigned(alessfn) then raise Exception.Create('wutafuck?!');
- lessfn := alessfn;
- SetLength(elem, 8192); // 'cause why not?
+ SetLength(elem, 128); // 'cause why not?
elemUsed := 0;
end;
elemUsed := 0;
end;
-destructor TBinaryHeapObj.Destroy ();
+destructor TBinaryHeapBase.Destroy ();
begin
elem := nil;
inherited;
end;
begin
elem := nil;
inherited;
end;
-procedure TBinaryHeapObj.clear ();
+procedure TBinaryHeapBase.clear ();
begin
elemUsed := 0;
end;
begin
elemUsed := 0;
end;
-procedure TBinaryHeapObj.heapify (root: Integer);
+procedure TBinaryHeapBase.heapify (root: Integer);
var
smallest, right: Integer;
var
smallest, right: Integer;
- tmp: TObject;
+ tmp: ITP;
begin
while true do
begin
smallest := 2*root+1; // left child
if (smallest >= elemUsed) then break; // anyway
right := smallest+1; // right child
begin
while true do
begin
smallest := 2*root+1; // left child
if (smallest >= elemUsed) then break; // anyway
right := smallest+1; // right child
- if not lessfn(elem[smallest], elem[root]) then smallest := root;
- if (right < elemUsed) and (lessfn(elem[right], elem[smallest])) then smallest := right;
+ if not CmpObjT.less(elem[smallest], elem[root]) then smallest := root;
+ if (right < elemUsed) and (CmpObjT.less(elem[right], elem[smallest])) then smallest := right;
if (smallest = root) then break;
// swap
tmp := elem[root];
if (smallest = root) then break;
// swap
tmp := elem[root];
end;
end;
-procedure TBinaryHeapObj.insert (val: TObject);
+procedure TBinaryHeapBase.insert (val: ITP);
var
i, par: Integer;
begin
var
i, par: Integer;
begin
- if (val = nil) then exit;
+ //if (val = nil) then exit;
i := elemUsed;
i := elemUsed;
- if (i = Length(elem)) then SetLength(elem, Length(elem)+16384); // arbitrary number
+ // grow?
+ if (i = Length(elem)) then
+ begin
+ if (i <= 65536) then par := i*2 else par := i+65536; // arbitrary numbers
+ SetLength(elem, par);
+ end;
+ // increase counter
Inc(elemUsed);
Inc(elemUsed);
+ // insert element
while (i <> 0) do
begin
par := (i-1) div 2; // parent
while (i <> 0) do
begin
par := (i-1) div 2; // parent
- if not lessfn(val, elem[par]) then break;
+ if not CmpObjT.less(val, elem[par]) then break;
elem[i] := elem[par];
i := par;
end;
elem[i] := val;
end;
elem[i] := elem[par];
i := par;
end;
elem[i] := val;
end;
-function TBinaryHeapObj.front (): TObject;
+function TBinaryHeapBase.front (): ITP;
begin
begin
- if elemUsed > 0 then result := elem[0] else result := nil;
+ if elemUsed > 0 then result := elem[0] else result := Default(ITP);
end;
end;
-procedure TBinaryHeapObj.popFront ();
+procedure TBinaryHeapBase.popFront ();
begin
if (elemUsed > 0) then
begin
begin
if (elemUsed > 0) then
begin