Changeset 33 for trunk/IPQ.pas


Ignore:
Timestamp:
Jan 8, 2017, 11:42:00 PM (7 years ago)
Author:
chronos
Message:
  • Fixed: Source formatting of some files due missing semicolon before until keyword.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/IPQ.pas

    r17 r33  
    1 {binary heap priority queue
    2 code contributed by Rassim Eminli}
     1{ binary heap priority queue
     2  code contributed by Rassim Eminli }
    33
    44{$INCLUDE Switches.pas}
    5 
    65unit IPQ;
    76
    … …  
    109type
    1110
    12 TIntegerArray = array[0..$40000000 div sizeof(integer)] of integer;
    13 PIntegerArray = ^TIntegerArray;
     11  TIntegerArray = array [0 .. $40000000 div sizeof(integer)] of integer;
     12  PIntegerArray = ^TIntegerArray;
    1413
    15 TheapItem = record
    16         Item:   integer;
    17         Value:  integer;
    18 end;
    19 
    20 TItemArray = array[0..$40000000 div sizeof(TheapItem)] of TheapItem;
    21 PItemArray = ^TItemArray;
    22 
    23 TIPQ = class
    24         constructor Create(max: integer);
    25         destructor Destroy; override;
    26         procedure Empty;
    27         function Put(Item, Value: integer): boolean;
    28         function TestPut(Item, Value: integer): boolean;
    29         function Get(var Item, Value: integer): boolean;
    30 private
    31 // n - is the size of the heap.
    32 // fmax - is the max size of the heap.
    33         n, fmax:        integer;
    34 
    35 // bh - stores (Value, Item) pairs of the heap.
    36 // Ix - stores the positions of pairs in the heap bh.
    37         bh:                     PItemArray;
    38         Ix:                     PIntegerArray;
     14  TheapItem = record
     15    Item: integer;
     16    Value: integer;
    3917  end;
    4018
     19  TItemArray = array [0 .. $40000000 div sizeof(TheapItem)] of TheapItem;
     20  PItemArray = ^TItemArray;
     21
     22  TIPQ = class
     23    constructor Create(max: integer);
     24    destructor Destroy; override;
     25    procedure Empty;
     26    function Put(Item, Value: integer): boolean;
     27    function TestPut(Item, Value: integer): boolean;
     28    function Get(var Item, Value: integer): boolean;
     29  private
     30    // n - is the size of the heap.
     31    // fmax - is the max size of the heap.
     32    n, fmax: integer;
     33
     34    // bh - stores (Value, Item) pairs of the heap.
     35    // Ix - stores the positions of pairs in the heap bh.
     36    bh: PItemArray;
     37    Ix: PIntegerArray;
     38  end;
    4139
    4240implementation
    … …  
    4442constructor TIPQ.Create(max: integer);
    4543begin
    46         inherited Create;
    47         fmax := max;
    48         GetMem(bh, fmax*SizeOf(TheapItem));
    49         GetMem(Ix, fmax*SizeOf(integer));
    50         n:=-1;
    51         Empty
     44  inherited Create;
     45  fmax := max;
     46  GetMem(bh, fmax * sizeof(TheapItem));
     47  GetMem(Ix, fmax * sizeof(integer));
     48  n := -1;
     49  Empty
    5250end;
    5351
    5452destructor TIPQ.Destroy;
    5553begin
    56         FreeMem(bh);
    57         FreeMem(Ix);
    58         inherited Destroy;
     54  FreeMem(bh);
     55  FreeMem(Ix);
     56  inherited Destroy;
    5957end;
    6058
    6159procedure TIPQ.Empty;
    6260begin
    63         if n <> 0 then
    64         begin
    65                 FillChar(Ix^, fmax*sizeOf(integer), 255);
    66                 n := 0;
    67         end;
     61  if n <> 0 then
     62  begin
     63    FillChar(Ix^, fmax * sizeof(integer), 255);
     64    n := 0;
     65  end;
    6866end;
    6967
    70 //Parent(i) = (i-1)/2.
    71 function TIPQ.Put(Item, Value: integer): boolean; //O(lg(n))
     68// Parent(i) = (i-1)/2.
     69function TIPQ.Put(Item, Value: integer): boolean; // O(lg(n))
    7270var
    73         i, j:   integer;
    74         lbh:    PItemArray;
    75         lIx:    PIntegerArray;
     71  i, j: integer;
     72  lbh: PItemArray;
     73  lIx: PIntegerArray;
    7674begin
    77         lIx := Ix;
    78         lbh := bh;
    79         i := lIx[Item];
    80         if i >= 0 then
    81         begin
    82                 if lbh[i].Value <= Value then
    83                 begin
    84                         result := False;
    85                         exit;
    86                 end;
    87         end
    88         else
    89         begin
    90                 i := n;
    91                 Inc(n);
    92         end;
     75  lIx := Ix;
     76  lbh := bh;
     77  i := lIx[Item];
     78  if i >= 0 then
     79  begin
     80    if lbh[i].Value <= Value then
     81    begin
     82      result := False;
     83      exit;
     84    end;
     85  end
     86  else
     87  begin
     88    i := n;
     89    Inc(n);
     90  end;
    9391
    94         while i > 0 do
    95         begin
    96                 j := (i-1) shr 1;       //Parent(i) = (i-1)/2
    97                 if Value >= lbh[j].Value then   break;
    98                 lbh[i] := lbh[j];
    99                 lIx[lbh[i].Item] := i;
    100                 i := j;
    101         end;
    102         //      Insert the new Item at the insertion point found.
    103         lbh[i].Value := Value;
    104         lbh[i].Item := Item;
    105         lIx[lbh[i].Item] := i;
    106         result := True;
     92  while i > 0 do
     93  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;
     100  end;
     101  // 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;
    107106end;
    108107
    109108function TIPQ.TestPut(Item, Value: integer): boolean;
    110109var
    111         i: integer;
     110  i: integer;
    112111begin
    113         i := Ix[Item];
    114         result := (i < 0) or (bh[i].Value > Value);
     112  i := Ix[Item];
     113  result := (i < 0) or (bh[i].Value > Value);
    115114end;
    116115
    117 //Left(i) = 2*i+1.
    118 //Right(i) = 2*i+2 => Left(i)+1
    119 function TIPQ.Get(var Item, Value: integer): boolean; //O(lg(n))
     116// Left(i) = 2*i+1.
     117// Right(i) = 2*i+2 => Left(i)+1
     118function TIPQ.Get(var Item, Value: integer): boolean; // O(lg(n))
    120119var
    121         i, j:   integer;
    122         last:   TheapItem;
    123         lbh:    PItemArray;
     120  i, j: integer;
     121  last: TheapItem;
     122  lbh: PItemArray;
    124123begin
    125         if n = 0 then
    126         begin
    127                 result := False;
    128                 exit;
    129         end;
     124  if n = 0 then
     125  begin
     126    result := False;
     127    exit;
     128  end;
    130129
    131         lbh := bh;
    132         Item := lbh[0].Item;
    133         Value := lbh[0].Value;
     130  lbh := bh;
     131  Item := lbh[0].Item;
     132  Value := lbh[0].Value;
    134133
    135         Ix[Item] := -1;
     134  Ix[Item] := -1;
    136135
    137         dec(n);
    138         if n > 0 then
    139         begin
    140                 last := lbh[n];
    141                 i := 0;         j := 1;
    142                 while j < n do
    143                 begin
    144                                                                                 //      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              break;
     136  dec(n);
     137  if n > 0 then
     138  begin
     139    last := lbh[n];
     140    i := 0;
     141    j := 1;
     142    while j < n do
     143    begin
     144      // 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;
    148149
    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
    153                 end;
     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
     154    end;
    154155
    155                 // Insert the root in the correct place in the heap.
    156                 lbh[i] := last;
    157                 Ix[last.Item] := i;
    158         end;
    159         result := True
     156    // Insert the root in the correct place in the heap.
     157    lbh[i] := last;
     158    Ix[last.Item] := i;
     159  end;
     160  result := True
    160161end;
    161162
    162163end.
    163 
Note: See TracChangeset for help on using the changeset viewer.