Changeset 303 for branches/highdpi/AI/StdAI/Pile.pas
- Timestamp:
- Mar 9, 2021, 9:19:49 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/AI/StdAI/Pile.pas
r210 r303 19 19 20 20 const 21 MaxSize=9600;21 MaxSize = 9600; 22 22 23 23 type 24 TheapItem = record25 Item:integer;26 Value:integer;27 end;24 TheapItem = record 25 Item: integer; 26 Value: integer; 27 end; 28 28 29 29 var 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; 33 33 {$IFDEF DEBUG}InUse: boolean;{$ENDIF} 34 34 … … 36 36 procedure Create(Size: integer); 37 37 begin 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} 48 52 end; 49 53 50 54 procedure Free; 51 55 begin 52 {$IFDEF DEBUG}assert(InUse);InUse:=false;{$ENDIF} 56 {$IFDEF DEBUG} 57 assert(InUse); 58 InUse := False; 59 {$ENDIF} 53 60 end; 54 61 55 62 procedure Empty; 56 63 begin 57 58 59 FillChar(Ix, CurrentSize*sizeOf(integer), 255);60 61 64 if n <> 0 then 65 begin 66 FillChar(Ix, CurrentSize * sizeOf(integer), 255); 67 n := 0; 68 end; 62 69 end; 63 70 … … 65 72 function Put(Item, Value: integer): boolean; //O(lg(n)) 66 73 var 67 i, j:integer;74 i, j: integer; 68 75 begin 69 assert(Item<CurrentSize);70 71 72 73 74 75 result := False;76 77 78 79 80 81 82 83 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; 84 91 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; 98 106 end; 99 107 100 108 function TestPut(Item, Value: integer): boolean; 101 109 var 102 110 i: integer; 103 111 begin 104 assert(Item<CurrentSize);105 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); 107 115 end; 108 116 … … 111 119 function Get(var Item, Value: integer): boolean; //O(lg(n)) 112 120 var 113 i, j:integer;114 last:TheapItem;121 i, j: integer; 122 last: TheapItem; 115 123 begin 116 117 118 result := False;119 120 124 if n = 0 then 125 begin 126 Result := False; 127 exit; 128 end; 121 129 122 123 130 Item := bh[0].Item; 131 Value := bh[0].Value; 124 132 125 133 Ix[Item] := -1; 126 134 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; 138 148 139 140 141 142 j := j shl 1+1;//Left(j) = 2*j+1143 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; 144 154 145 146 147 148 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; 150 160 end; 151 161 152 162 initialization 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} 156 168 end. 157
Note:
See TracChangeset
for help on using the changeset viewer.