X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fbinheap.pas;h=50531ed6f453d79044597739bf48d813dfe96c6f;hb=0e354ade87a9aee657de86b63d4100b1dce7b483;hp=968c5f94221e63a73ced2a96a109eda6ff99daf0;hpb=e27a7539a5cd40fb3a15c6daef0e18817b7c9bd8;p=d2df-sdl.git diff --git a/src/shared/binheap.pas b/src/shared/binheap.pas index 968c5f9..50531ed 100644 --- a/src/shared/binheap.pas +++ b/src/shared/binheap.pas @@ -21,11 +21,14 @@ interface type - TBinaryHeapLessFn = function (a, b: TObject): Boolean; + // WARNING! don't put structures into heap, use ponters or ids! + generic TBinaryHeapBase = class(TObject) + private + type + TBinaryHeapLessFn = function (a, b: ITP): Boolean; - TBinaryHeapObj = class(TObject) private - elem: array of TObject; + elem: array of ITP; elemUsed: Integer; lessfn: TBinaryHeapLessFn; @@ -38,15 +41,24 @@ type procedure clear (); - procedure insert (val: TObject); + procedure insert (val: ITP); - function front (): TObject; + function front (): ITP; procedure popFront (); property count: Integer read elemUsed; end; +type + TBinaryHeapObj = specialize TBinaryHeapBase; + TBinaryHeapInt = specialize TBinaryHeapBase; + + +function binHeapNewIntLess (): TBinaryHeapInt; +function binHeapNewIntGreat (): TBinaryHeapInt; + + implementation uses @@ -54,32 +66,41 @@ uses // ////////////////////////////////////////////////////////////////////////// // -constructor TBinaryHeapObj.Create (alessfn: TBinaryHeapLessFn); +function intLess (a, b: Integer): Boolean; begin result := (a < b); end; +function intGreat (a, b: Integer): Boolean; begin result := (a > b); end; + + +function binHeapNewIntLess (): TBinaryHeapInt; begin result := TBinaryHeapInt.Create(@intLess); end; +function binHeapNewIntGreat (): TBinaryHeapInt; begin result := TBinaryHeapInt.Create(@intGreat); end; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TBinaryHeapBase.Create (alessfn: TBinaryHeapLessFn); 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; -destructor TBinaryHeapObj.Destroy (); +destructor TBinaryHeapBase.Destroy (); begin elem := nil; inherited; end; -procedure TBinaryHeapObj.clear (); +procedure TBinaryHeapBase.clear (); begin elemUsed := 0; end; -procedure TBinaryHeapObj.heapify (root: Integer); +procedure TBinaryHeapBase.heapify (root: Integer); var smallest, right: Integer; - tmp: TObject; + tmp: ITP; begin while true do begin @@ -98,14 +119,21 @@ begin end; -procedure TBinaryHeapObj.insert (val: TObject); +procedure TBinaryHeapBase.insert (val: ITP); var i, par: Integer; begin - if (val = nil) then exit; + //if (val = nil) then exit; 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); + // insert element while (i <> 0) do begin par := (i-1) div 2; // parent @@ -116,13 +144,13 @@ begin elem[i] := val; end; -function TBinaryHeapObj.front (): TObject; +function TBinaryHeapBase.front (): ITP; begin - if elemUsed > 0 then result := elem[0] else result := nil; + if elemUsed > 0 then result := elem[0] else result := Default(ITP); end; -procedure TBinaryHeapObj.popFront (); +procedure TBinaryHeapBase.popFront (); begin if (elemUsed > 0) then begin