Changeset 583 for trunk/AI Template/Pile.pas
- Timestamp:
- May 23, 2024, 10:14:11 PM (6 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/AI Template/Pile.pas
r582 r583 8 8 interface 9 9 10 procedure Create(Size: integer);10 procedure Create(Size: Integer); 11 11 procedure Free; 12 12 procedure Empty; 13 function Put(Item, Value: integer): boolean;14 function TestPut(Item, Value: integer): boolean;15 function Get(var Item, Value: integer): boolean;13 function Put(Item, Value: Integer): Boolean; 14 function TestPut(Item, Value: Integer): Boolean; 15 function Get(var Item, Value: Integer): Boolean; 16 16 17 17 … … 23 23 type 24 24 TheapItem = record 25 Item: integer;26 Value: integer;25 Item: Integer; 26 Value: Integer; 27 27 end; 28 28 29 29 var 30 30 bh: array[0..MaxSize - 1] of TheapItem; 31 Ix: array[0..MaxSize - 1] of integer;32 n, CurrentSize: integer;33 {$IFDEF DEBUG}InUse: boolean;{$ENDIF}31 Ix: array[0..MaxSize - 1] of Integer; 32 N, CurrentSize: Integer; 33 {$IFDEF DEBUG}InUse: Boolean;{$ENDIF} 34 34 35 35 36 procedure Create(Size: integer);36 procedure Create(Size: Integer); 37 37 begin 38 38 {$IFDEF DEBUG} 39 assert(not InUse, 'Pile is a single instance class, ' +39 Assert(not InUse, 'Pile is a single instance class, ' + 40 40 'no multiple usage possible. Always call Pile.Free after use.'); 41 42 assert(Size <= MaxSize);43 if ( n<> 0) or (Size > CurrentSize) then41 {$ENDIF} 42 Assert(Size <= MaxSize); 43 if (N <> 0) or (Size > CurrentSize) then 44 44 begin 45 FillChar(Ix, Size * sizeOf(integer), 255);46 n:= 0;45 FillChar(Ix, Size * SizeOf(Integer), 255); 46 N := 0; 47 47 end; 48 48 CurrentSize := Size; 49 49 {$IFDEF DEBUG} 50 50 InUse := True; 51 51 {$ENDIF} 52 52 end; 53 53 54 54 procedure Free; 55 55 begin 56 57 assert(InUse);56 {$IFDEF DEBUG} 57 Assert(InUse); 58 58 InUse := False; 59 59 {$ENDIF} 60 60 end; 61 61 62 62 procedure Empty; 63 63 begin 64 if n<> 0 then64 if N <> 0 then 65 65 begin 66 FillChar(Ix, CurrentSize * sizeOf(integer), 255);67 n:= 0;66 FillChar(Ix, CurrentSize * SizeOf(Integer), 255); 67 N := 0; 68 68 end; 69 69 end; 70 70 71 // Parent(i) = (i-1)/2.72 function Put(Item, Value: integer): boolean; //O(lg(n))71 // Parent(i) = (i-1)/2. 72 function Put(Item, Value: Integer): Boolean; // O(lg(n)) 73 73 var 74 i, j: integer;74 I, J: Integer; 75 75 begin 76 assert(Item < CurrentSize);77 i:= Ix[Item];78 if i>= 0 then76 Assert(Item < CurrentSize); 77 I := Ix[Item]; 78 if I >= 0 then 79 79 begin 80 if bh[ i].Value <= Value then80 if bh[I].Value <= Value then 81 81 begin 82 82 Result := False; 83 exit;83 Exit; 84 84 end; 85 85 end 86 86 else 87 87 begin 88 i := n;89 Inc( n);88 I := N; 89 Inc(N); 90 90 end; 91 91 92 while i> 0 do92 while I > 0 do 93 93 begin 94 j := (i - 1) shr 1; //Parent(i) = (i-1)/2 95 if Value >= bh[j].Value then break; 96 bh[i] := bh[j]; 97 Ix[bh[i].Item] := i; 98 i := j; 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; 99 100 end; 100 // 101 bh[ i].Value := Value;102 bh[ i].Item := Item;103 Ix[bh[ i].Item] := i;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; 104 105 Result := True; 105 106 end; 106 107 107 function TestPut(Item, Value: integer): boolean;108 function TestPut(Item, Value: Integer): Boolean; 108 109 var 109 i: integer;110 I: Integer; 110 111 begin 111 assert(Item < CurrentSize);112 i:= Ix[Item];113 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); 114 115 end; 115 116 116 117 //Left(i) = 2*i+1. 117 118 //Right(i) = 2*i+2 => Left(i)+1 118 function Get(var Item, Value: integer): boolean; //O(lg(n))119 function Get(var Item, Value: Integer): Boolean; //O(lg(n)) 119 120 var 120 i, j: integer;121 last: TheapItem;121 I, J: Integer; 122 Last: TheapItem; 122 123 begin 123 if n= 0 then124 if N = 0 then 124 125 begin 125 126 Result := False; 126 exit;127 Exit; 127 128 end; 128 129 … … 132 133 Ix[Item] := -1; 133 134 134 Dec( n);135 if n> 0 then135 Dec(N); 136 if N > 0 then 136 137 begin 137 last := bh[n];138 i:= 0;139 j:= 1;140 while j < ndo138 Last := bh[N]; 139 I := 0; 140 J := 1; 141 while J < N do 141 142 begin 142 143 // Right(i) = Left(i)+1 143 if (j < n - 1) and (bh[j].Value > bh[j + 1].Value) then 144 Inc(j); 145 if last.Value <= bh[j].Value then break; 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; 146 148 147 bh[ i] := bh[j];148 Ix[bh[ i].Item] := i;149 i := j;150 j := jshl 1 + 1; //Left(j) = 2*j+1149 bh[I] := bh[J]; 150 Ix[bh[I].Item] := I; 151 I := J; 152 J := J shl 1 + 1; //Left(j) = 2*j+1 151 153 end; 152 154 153 155 // Insert the root in the correct place in the heap. 154 bh[ i] := last;155 Ix[ last.Item] := i;156 bh[I] := Last; 157 Ix[Last.Item] := I; 156 158 end; 157 159 Result := True; … … 159 161 160 162 initialization 161 n:= 0;163 N := 0; 162 164 CurrentSize := 0; 163 165 {$IFDEF DEBUG} 164 166 InUse := False; 165 167 {$ENDIF} 166 168 end.
Note:
See TracChangeset
for help on using the changeset viewer.