Ignore:
Timestamp:
Nov 30, 2023, 10:16:14 PM (6 months ago)
Author:
chronos
Message:
  • Modified: Updated high dpi branch from trunk.
  • Modified: Use generics.collections instead of fgl.
  • Modified: Compile with Delphi syntax.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/IPQ.pas

    r303 r465  
    11{ binary heap priority queue
    2   code contributed by Rassim Eminli }
     2  Code contributed by Rassim Eminli }
    33
    44{$INCLUDE Switches.inc}
    … …  
    88
    99type
    10 
    11   TIntegerArray = array [0 .. $40000000 div sizeof(integer)] of integer;
     10  TIntegerArray = array [0 .. $40000000 div SizeOf(Integer)] of Integer;
    1211  PIntegerArray = ^TIntegerArray;
    1312
    1413  TheapItem = record
    15     Item: integer;
    16     Value: integer;
     14    Item: Integer;
     15    Value: Integer;
    1716  end;
    1817
    19   TItemArray = array [0 .. $40000000 div sizeof(TheapItem)] of TheapItem;
     18  TItemArray = array [0 .. $40000000 div SizeOf(TheapItem)] of TheapItem;
    2019  PItemArray = ^TItemArray;
    2120
    2221  TIPQ = class
    23     constructor Create(max: integer);
     22    constructor Create(Max: Integer);
    2423    destructor Destroy; override;
    2524    procedure Empty;
    26     function Put(Item, Value: integer): boolean;
    27     function TestPut(Item, Value: integer): boolean;
    28     function Get(var Item, Value: integer): boolean;
     25    function Put(Item, Value: Integer): Boolean;
     26    function TestPut(Item, Value: Integer): Boolean;
     27    function Get(var Item, Value: Integer): Boolean;
    2928  private
    3029    // n - is the size of the heap.
    3130    // fmax - is the max size of the heap.
    32     n, fmax: integer;
     31    N, fmax: Integer;
    3332
    3433    // bh - stores (Value, Item) pairs of the heap.
    … …  
    4039implementation
    4140
    42 constructor TIPQ.Create(max: integer);
     41constructor TIPQ.Create(Max: Integer);
    4342begin
    4443  inherited Create;
    45   fmax := max;
    46   GetMem(bh, fmax * sizeof(TheapItem));
    47   GetMem(Ix, fmax * sizeof(integer));
    48   n := -1;
     44  fmax := Max;
     45  GetMem(bh, fmax * SizeOf(TheapItem));
     46  GetMem(Ix, fmax * SizeOf(Integer));
     47  N := -1;
    4948  Empty;
    5049end;
    … …  
    5958procedure TIPQ.Empty;
    6059begin
    61   if n <> 0 then
     60  if N <> 0 then
    6261  begin
    63     FillChar(Ix^, fmax * sizeof(integer), 255);
    64     n := 0;
     62    FillChar(Ix^, fmax * SizeOf(Integer), 255);
     63    N := 0;
    6564  end;
    6665end;
    6766
    6867// Parent(i) = (i-1)/2.
    69 function TIPQ.Put(Item, Value: integer): boolean; // O(lg(n))
     68function TIPQ.Put(Item, Value: Integer): Boolean; // O(lg(n))
    7069var
    71   i, j: integer;
     70  I, J: Integer;
    7271  lbh: PItemArray;
    7372  lIx: PIntegerArray;
    … …  
    7574  lIx := Ix;
    7675  lbh := bh;
    77   i := lIx[Item];
    78   if i >= 0 then
     76  I := lIx[Item];
     77  if I >= 0 then
    7978  begin
    80     if lbh[i].Value <= Value then
     79    if lbh[I].Value <= Value then
    8180    begin
    82       result := False;
    83       exit;
     81      Result := False;
     82      Exit;
    8483    end;
    8584  end
    8685  else
    8786  begin
    88     i := n;
    89     Inc(n);
     87    I := N;
     88    Inc(N);
    9089  end;
    9190
    92   while i > 0 do
     91  while I > 0 do
    9392  begin
    94     j := (i - 1) shr 1; // Parent(i) = (i-1)/2
    95     if Value >= lbh[j].Value then
    96       break;
    97     lbh[i] := lbh[j];
    98     lIx[lbh[i].Item] := i;
    99     i := j;
     93    J := (I - 1) shr 1; // Parent(i) = (i-1)/2
     94    if Value >= lbh[J].Value then
     95      Break;
     96    lbh[I] := lbh[J];
     97    lIx[lbh[I].Item] := I;
     98    I := J;
    10099  end;
    101100  // Insert the new Item at the insertion point found.
    102   lbh[i].Value := Value;
    103   lbh[i].Item := Item;
    104   lIx[lbh[i].Item] := i;
    105   result := True;
     101  lbh[I].Value := Value;
     102  lbh[I].Item := Item;
     103  lIx[lbh[I].Item] := I;
     104  Result := True;
    106105end;
    107106
    108 function TIPQ.TestPut(Item, Value: integer): boolean;
     107function TIPQ.TestPut(Item, Value: Integer): Boolean;
    109108var
    110   i: integer;
     109  I: Integer;
    111110begin
    112   i := Ix[Item];
    113   result := (i < 0) or (bh[i].Value > Value);
     111  I := Ix[Item];
     112  Result := (I < 0) or (bh[I].Value > Value);
    114113end;
    115114
    116115// Left(i) = 2*i+1.
    117116// Right(i) = 2*i+2 => Left(i)+1
    118 function TIPQ.Get(var Item, Value: integer): boolean; // O(lg(n))
     117function TIPQ.Get(var Item, Value: Integer): Boolean; // O(lg(n))
    119118var
    120   i, j: integer;
    121   last: TheapItem;
     119  I, J: Integer;
     120  Last: TheapItem;
    122121  lbh: PItemArray;
    123122begin
    124   if n = 0 then
     123  if N = 0 then
    125124  begin
    126     result := False;
    127     exit;
     125    Result := False;
     126    Exit;
    128127  end;
    129128
    … …  
    134133  Ix[Item] := -1;
    135134
    136   dec(n);
    137   if n > 0 then
     135  Dec(N);
     136  if N > 0 then
    138137  begin
    139     last := lbh[n];
    140     i := 0;
    141     j := 1;
    142     while j < n do
     138    Last := lbh[N];
     139    I := 0;
     140    J := 1;
     141    while J < N do
    143142    begin
    144143      // Right(i) = Left(i)+1
    145       if (j < n - 1) and (lbh[j].Value > lbh[j + 1].Value) then
    146         Inc(j);
    147       if last.Value <= lbh[j].Value then
    148         break;
     144      if (J < N - 1) and (lbh[J].Value > lbh[J + 1].Value) then
     145        Inc(J);
     146      if Last.Value <= lbh[J].Value then
     147        Break;
    149148
    150       lbh[i] := lbh[j];
    151       Ix[lbh[i].Item] := i;
    152       i := j;
    153       j := j shl 1 + 1; // Left(j) = 2*j+1
     149      lbh[I] := lbh[J];
     150      Ix[lbh[I].Item] := I;
     151      I := J;
     152      J := J shl 1 + 1; // Left(j) = 2*j+1
    154153    end;
    155154
    156155    // Insert the root in the correct place in the heap.
    157     lbh[i] := last;
    158     Ix[last.Item] := i;
     156    lbh[I] := Last;
     157    Ix[Last.Item] := I;
    159158  end;
    160   result := True
     159  Result := True;
    161160end;
    162161
Note: See TracChangeset for help on using the changeset viewer.