Ignore:
Timestamp:
Mar 9, 2021, 9:19:49 AM (4 years ago)
Author:
chronos
Message:
  • Modified: Synced code with current trunk version.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/AI/StdAI/Pile.pas

    r210 r303  
    1919
    2020const
    21 MaxSize=9600;
     21  MaxSize = 9600;
    2222
    2323type
    24 TheapItem = record
    25         Item:   integer;
    26         Value:  integer;
    27 end;
     24  TheapItem = record
     25    Item: integer;
     26    Value: integer;
     27  end;
    2828
    2929var
    30 bh: array[0..MaxSize-1] of TheapItem;
    31 Ix: array[0..MaxSize-1] of integer;
    32 n, CurrentSize: integer;
     30  bh: array[0..MaxSize - 1] of TheapItem;
     31  Ix: array[0..MaxSize - 1] of integer;
     32  n, CurrentSize: integer;
    3333{$IFDEF DEBUG}InUse: boolean;{$ENDIF}
    3434
     
    3636procedure Create(Size: integer);
    3737begin
    38         {$IFDEF DEBUG}assert(not InUse, 'Pile is a single instance class, '
    39           +'no multiple usage possible. Always call Pile.Free after use.');{$ENDIF}
    40         assert(Size<=MaxSize);
    41         if (n <> 0) or (Size > CurrentSize) then
    42         begin
    43                 FillChar(Ix, Size*sizeOf(integer), 255);
    44                 n := 0;
    45         end;
    46         CurrentSize := Size;
    47         {$IFDEF DEBUG}InUse:=true;{$ENDIF}
     38  {$IFDEF DEBUG}
     39  assert(not InUse, 'Pile is a single instance class, ' +
     40    'no multiple usage possible. Always call Pile.Free after use.');
     41{$ENDIF}
     42  assert(Size <= MaxSize);
     43  if (n <> 0) or (Size > CurrentSize) then
     44  begin
     45    FillChar(Ix, Size * sizeOf(integer), 255);
     46    n := 0;
     47  end;
     48  CurrentSize := Size;
     49        {$IFDEF DEBUG}
     50  InUse := True;
     51{$ENDIF}
    4852end;
    4953
    5054procedure Free;
    5155begin
    52         {$IFDEF DEBUG}assert(InUse);InUse:=false;{$ENDIF}
     56        {$IFDEF DEBUG}
     57  assert(InUse);
     58  InUse := False;
     59{$ENDIF}
    5360end;
    5461
    5562procedure Empty;
    5663begin
    57         if n <> 0 then
    58         begin
    59                 FillChar(Ix, CurrentSize*sizeOf(integer), 255);
    60                 n := 0;
    61         end;
     64  if n <> 0 then
     65  begin
     66    FillChar(Ix, CurrentSize * sizeOf(integer), 255);
     67    n := 0;
     68  end;
    6269end;
    6370
     
    6572function Put(Item, Value: integer): boolean; //O(lg(n))
    6673var
    67         i, j:   integer;
     74  i, j: integer;
    6875begin
    69         assert(Item<CurrentSize);
    70         i := Ix[Item];
    71         if i >= 0 then
    72         begin
    73                 if bh[i].Value <= Value then
    74                 begin
    75                         result := False;
    76                         exit;
    77                 end;
    78         end
    79         else
    80         begin
    81                 i := n;
    82                 Inc(n);
    83         end;
     76  assert(Item < CurrentSize);
     77  i := Ix[Item];
     78  if i >= 0 then
     79  begin
     80    if bh[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;
    8491
    85         while i > 0 do
    86         begin
    87                 j := (i-1) shr 1;       //Parent(i) = (i-1)/2
    88                 if Value >= bh[j].Value then    break;
    89                 bh[i] := bh[j];
    90                 Ix[bh[i].Item] := i;
    91                 i := j;
    92         end;
    93         //      Insert the new Item at the insertion point found.
    94         bh[i].Value := Value;
    95         bh[i].Item := Item;
    96         Ix[bh[i].Item] := i;
    97         result := True;
     92  while i > 0 do
     93  begin
     94    j := (i - 1) shr 1;  //Parent(i) = (i-1)/2
     95    if Value >= bh[j].Value then
     96      break;
     97    bh[i] := bh[j];
     98    Ix[bh[i].Item] := i;
     99    i := j;
     100  end;
     101  //  Insert the new Item at the insertion point found.
     102  bh[i].Value := Value;
     103  bh[i].Item := Item;
     104  Ix[bh[i].Item] := i;
     105  Result := True;
    98106end;
    99107
    100108function TestPut(Item, Value: integer): boolean;
    101109var
    102         i: integer;
     110  i: integer;
    103111begin
    104         assert(Item<CurrentSize);
    105         i := Ix[Item];
    106         result := (i < 0) or (bh[i].Value > Value);
     112  assert(Item < CurrentSize);
     113  i := Ix[Item];
     114  Result := (i < 0) or (bh[i].Value > Value);
    107115end;
    108116
     
    111119function Get(var Item, Value: integer): boolean; //O(lg(n))
    112120var
    113         i, j:   integer;
    114         last:   TheapItem;
     121  i, j: integer;
     122  last: TheapItem;
    115123begin
    116         if n = 0 then
    117         begin
    118                 result := False;
    119                 exit;
    120         end;
     124  if n = 0 then
     125  begin
     126    Result := False;
     127    exit;
     128  end;
    121129
    122         Item := bh[0].Item;
    123         Value := bh[0].Value;
     130  Item := bh[0].Item;
     131  Value := bh[0].Value;
    124132
    125         Ix[Item] := -1;
     133  Ix[Item] := -1;
    126134
    127         dec(n);
    128         if n > 0 then
    129         begin
    130                 last := bh[n];
    131                 i := 0;         j := 1;
    132                 while j < n do
    133                 begin
    134                                                                                 //      Right(i) = Left(i)+1
    135                         if(j < n-1) and (bh[j].Value > bh[j + 1].Value)then
    136                                 inc(j);
    137                         if last.Value <= bh[j].Value then               break;
     135  Dec(n);
     136  if n > 0 then
     137  begin
     138    last := bh[n];
     139    i := 0;
     140    j := 1;
     141    while j < n do
     142    begin
     143      //  Right(i) = Left(i)+1
     144      if (j < n - 1) and (bh[j].Value > bh[j + 1].Value) then
     145        Inc(j);
     146      if last.Value <= bh[j].Value then
     147        break;
    138148
    139                         bh[i] := bh[j];
    140                         Ix[bh[i].Item] := i;
    141                         i := j;
    142                         j := j shl 1+1; //Left(j) = 2*j+1
    143                 end;
     149      bh[i] := bh[j];
     150      Ix[bh[i].Item] := i;
     151      i := j;
     152      j := j shl 1 + 1;  //Left(j) = 2*j+1
     153    end;
    144154
    145                 // Insert the root in the correct place in the heap.
    146                 bh[i] := last;
    147                 Ix[last.Item] := i;
    148         end;
    149         result := True
     155    // Insert the root in the correct place in the heap.
     156    bh[i] := last;
     157    Ix[last.Item] := i;
     158  end;
     159  Result := True;
    150160end;
    151161
    152162initialization
    153         n:=0;
    154         CurrentSize:=0;
    155         {$IFDEF DEBUG}InUse:=false;{$ENDIF}
     163  n := 0;
     164  CurrentSize := 0;
     165        {$IFDEF DEBUG}
     166  InUse := False;
     167{$ENDIF}
    156168end.
    157 
Note: See TracChangeset for help on using the changeset viewer.