1 {
2 Copyright (C) 2014 Yann Mérignac
3
4 This library is free software; you can redistribute it and/or modify
5 it under the terms of the GNU Lesser General Public License as
6 published by the Free Software Foundation; either version 2.1 of the
7 License, or (at your option) any later version.
8
9 This library is distributed in the hope that it will be useful, but
10 WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 Lesser General Public License for more details.
13
14 As a special exception, the copyright holders of this library give
15 you permission to link this library with independent modules to
16 produce an executable, regardless of the license terms of these
17 independent modules,and to copy and distribute the resulting
18 executable under terms of your choice, provided that you also meet,
19 for each linked independent module, the terms and conditions of the
20 license of that module. An independent module is a module which is
21 not derived from or based on this library. If you modify this
22 library, you may extend this exception to your version of the
23 library, but you are not obligated to do so. If you do not wish to
24 do so, delete this exception statement from your version.
25
26 You should have received a copy of the GNU Lesser General Public
27 License along with this library. If not, see
28 <http://www.gnu.org/licenses/>.
29 }
30 unit GContnrs;
31
32 {$mode objfpc}{$H+}
33
34 interface
35
36 uses Classes, SysUtils;
37
38 const
39 MIN_BUCKET_COUNT = 4;
40 MAX_BUCKET_COUNT = 1 shl 30;
41 DEFAULT_HASHMAP_LOAD_FACTOR = 1.0;
42
43 type
44 EContainerError = class(Exception);
45
46 { TContainer }
47 TContainer = class
48 protected
49 procedure RaiseContainerEmpty;
50 procedure RaiseCursorDenotesWrongContainer;
51 procedure RaiseCursorIsNil;
52 procedure RaiseError(const Msg: String);
53 procedure RaiseIndexOutOfRange;
54 procedure RaiseItemAlreadyInSet;
55 procedure RaiseItemNotInSet;
56 procedure RaiseKeyAlreadyInMap;
57 procedure RaiseKeyNotInMap;
58 procedure RaiseMethodNotRedefined;
59 procedure Unused(P: Pointer); inline;
60 end;
61
62 { TGenEnumerator }
63
64 generic TGenEnumerator<_TItem_, _TPosition_> = class
65 public type
onstnull66 TGetCurrent = function(const Pos: _TPosition_) : _TItem_ of object;
arnull67 TMoveNext = function(var Pos:_TPosition_) : Boolean of object;
68 private
69 fGetter : TGetCurrent;
70 fMover : TMoveNext;
71 fPos : _TPosition_;
72
GetCurrentnull73 function GetCurrent : _TItem_;
74 public
75 constructor Create(const Pos : _TPosition_; Mover: TMoveNext;
76 Getter: TGetCurrent);
MoveNextnull77 function MoveNext: Boolean;
78 property Current: _TItem_ read GetCurrent;
79 end;
80
81 { TAbstractVector }
82
83 TAbstractVector = class(TContainer)
84 protected
85 fCapacity : Integer;
86 fSize : Integer;
87
88 procedure CheckIndex(Index: Integer); inline;
89 procedure CheckIndexForAdd(Index: Integer); inline;
90 procedure InsertSpaceFast(Position, Count: Integer); virtual; abstract;
ItemToStringnull91 function ItemToString(Index: Integer) : String; virtual; abstract;
92 procedure SetCapacity(ACapacity : Integer); virtual; abstract;
93 public
94 {** Removes all the items from the container. }
95 procedure Clear;
96
97 {** Deletes Count items begining at Position. }
98 procedure Delete(Position: Integer; Count: Integer = 1);
99
100 {** Deletes the first Count items. }
101 procedure DeleteFirst(Count: Integer = 1);
102
103 {** Deletes the last Count items. }
104 procedure DeleteLast(Count: Integer = 1);
105
106 {** Deletes all items in the range [PosFrom..PosTo]. }
107 procedure DeleteRange(PosFrom, PosTo: Integer);
108
109 {** Inserts Count undefined items at Position. }
110 procedure InsertSpace(Position: Integer; Count: Integer = 1);
111
112 {** Returns true if the container is empty. }
IsEmptynull113 function IsEmpty: Boolean; inline;
114
115 {** Copies Count items from Src to Dst. }
116 procedure Move(Src, Dst, Count: Integer); virtual; abstract;
117
118 {** If necessary, increases the capacity of the container to ensure that it
119 can hold at least MinCapacity items. }
120 procedure Reserve(MinCapacity: Integer);
121
122 {** Resizes the container to contain NewSize items. }
123 procedure Resize(NewSize: Integer);
124
125 {** Reorders the items in reverse order. }
126 procedure Reverse;
127
128 {** Reorders the items in the range [PosFrom..PosTo] in reverse order. }
129 procedure ReverseRange(PosFrom, PosTo: Integer);
130
131 {** Rearrange items randomly. }
132 procedure Shuffle;
133
134 {** Rearrange items in the range [PosFrom..PosTo] randomly. }
135 procedure Shuffle(PosFrom, PosTo: Integer);
136
137 {** Swaps the values of the items designated by I and J. }
138 procedure Swap(I, J: Integer);
139
140 {** Swaps the values of the items designated by I and J (no bounds check). }
141 procedure SwapFast(I, J: Integer); virtual; abstract;
142
143 {** Return a string representation for the container. }
ToStringnull144 function ToString : String; override;
145
146 {** Capacity of the container. }
147 property Capacity : Integer read fCapacity;
148
149 {** Number of items. }
150 property Size: Integer read fSize;
151 end;
152
153 { TGenVector }
154
155 generic TGenVector<_TItem_> = class(TAbstractVector)
156 public type
157 PItem = ^_TItem_;
158 TCompareItems = function (const A, B: _TItem_) : Integer of object;
159 TItemToString = function (const Item: _TItem_) : String of object;
160 TProcessItem = procedure(var Item: _TItem_) of object;
161 TEnumerator = specialize TGenEnumerator<_TItem_, Integer>;
162
163 strict private
164 fItems : array of _TItem_;
165 fOnCompareItems: TCompareItems;
166 fOnItemToString: TItemToString;
167
EnumeratorGetnull168 function EnumeratorGet(const Pos: Integer) : _TItem_;
EnumeratorNextnull169 function EnumeratorNext(var Pos: Integer) : Boolean;
170 procedure Fill(Index, Count: Integer; const Value: _TItem_);
GetItemFastnull171 function GetItemFast(Position: Integer) : _TItem_; inline;
GetItemPtrFastnull172 function GetItemPtrFast(Position: Integer): PItem;
173 procedure InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
174 procedure Quicksort(Left, Right: Integer; Comparator: TCompareItems);
175 class procedure RealMove(Src, Dst: TGenVector;
176 SrcFirst, DstFirst, Count: Integer);
177 procedure SetOnCompareItems(AValue: TCompareItems);
178 procedure SetOnItemToString(AValue: TItemToString);
179
180 protected
181 procedure InsertSpaceFast(Position, Count: Integer); override;
ItemToStringnull182 function ItemToString(Index: Integer) : String; override;
183 procedure SetCapacity(ACapacity : Integer); override;
184 public
185 {** Inserts Count times Item at the end of the container. }
186 procedure Append(const Item: _TItem_);
187
188 {** Inserts all the items of Src at the end of the container. }
189 procedure AppendAll(Src: TGenVector);
190
191 {** Inserts all the items of Src in the range [PosFrom..PosTo] at the end of
192 the container. }
193 procedure AppendRange(Src: TGenVector; PosFrom, PosTo: Integer);
194
195 {** Searches for Item using the binary search algorithm. Returns the index of
196 Item if its found. Otherwise, returns ( - InsertionPoint - 1 ).
197 InsertionPoint is the point at which the key would be inserted into the
198 container. }
BinarySearchnull199 function BinarySearch(const Item: _TItem_) : Integer;
BinarySearchnull200 function BinarySearch(const Item: _TItem_;
201 Comparator: TCompareItems) : Integer;
202
203 {** Searches for Item in range [PosFrom..PosTo] using the binary search
204 algorithm. Returns the index of Item if its found. Otherwise, returns
205 ( - InsertionPoint - 1 ). InsertionPoint is the point at which the key
206 would be inserted into the range. }
BinarySearchnull207 function BinarySearch(const Item: _TItem_;
208 PosFrom, PosTo: Integer) : Integer;
BinarySearchnull209 function BinarySearch(const Item: _TItem_;
210 PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
211
212 {** Returns true if the container contains Item. }
Containsnull213 function Contains(const Item: _TItem_) : Boolean;
Containsnull214 function Contains(const Item: _TItem_; Comparator: TCompareItems) : Boolean;
215
216 {** Creates an empty vector and sets his capacity to InitialCapacity. }
217 constructor Create(InitialCapacity: Integer = 16);
218
DefaultCompareItemsnull219 function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull220 function DefaultItemToString(const Item: _TItem_) : String; virtual;
221
222 {** Destroys the container. }
223 destructor Destroy; override;
224
225 {** If Obj = Self then returns true, else if Obj is not a TGenVector returns
226 false, else returns true if Self and Obj contain the sames items. }
Equalsnull227 function Equals(Obj: TObject) : Boolean; override;
Equalsnull228 function Equals(Obj: TObject; Comparator: TCompareItems) : Boolean;
229
230 {** Returns the index of the first item equal to Item or -1. }
FindIndexnull231 function FindIndex(const Item: _TItem_) : Integer;
FindIndexnull232 function FindIndex(const Item: _TItem_;
233 Comparator: TCompareItems) : Integer;
234
235 {** Returns a cursor on the first item equal to Item or NilCursor. The search
236 starts at the element From. }
FindIndexnull237 function FindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
FindIndexnull238 function FindIndex(const Item: _TItem_; PosFrom: Integer;
239 Comparator: TCompareItems) : Integer;
240
241 {** Returns the first Item. }
FirstItemnull242 function FirstItem : _TItem_; inline;
243
GetEnumeratornull244 function GetEnumerator : TEnumerator;
245
246 {** Returns item at position Position. }
GetItemnull247 function GetItem(Position: Integer) : _TItem_; inline;
248
249 {** Returns a pointer designating item at position Position. }
GetItemPtrnull250 function GetItemPtr(Position: Integer): PItem;
251
252 {** Inserts Count times Item before Before. }
253 procedure Insert(Before: Integer; const Item: _TItem_;
254 Count: Integer = 1);
255
256 {** Inserts all the items of Src before Before. }
257 procedure InsertAll(Before: Integer; Src: TGenVector);
258
259 {** Inserts before Before all the items of Src in the range
260 [PosFrom..PosTo]. }
261 procedure InsertRange(Before: Integer; Src: TGenVector;
262 PosFrom, PosTo: Integer);
263
264 {** Returns true if the items are sorted. }
IsSortednull265 function IsSorted : Boolean;
IsSortednull266 function IsSorted(Comparator: TCompareItems): Boolean;
267
268 {** Invokes Process on each items. }
269 procedure Iterate(Process: TProcessItem);
270
271 {** Invokes Process on each items in range [PosFrom..PosTo]. }
272 procedure Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
273
274 {** Returns the last Item. }
LastItemnull275 function LastItem: _TItem_; inline;
276
277 {** Returns index of the greatest item. }
MaxPosnull278 function MaxPos : Integer;
MaxPosnull279 function MaxPos(Comparator: TCompareItems) : Integer;
280
281 {** Returns index of the greatest item in the range [PosFrom..PosTo]. }
MaxPosnull282 function MaxPos(PosFrom, PosTo: Integer) : Integer;
MaxPosnull283 function MaxPos(PosFrom, PosTo: Integer;
284 Comparator: TCompareItems) : Integer;
285
286 {** Removes items from Src and inserts them into Self. Afterwards, Self
287 contains the union of the items that were initially in Src and Self. Src
288 is left empty. If Self and Src are initially sorted, then Self is
289 sorted. }
290 procedure Merge(Src: TGenVector);
291 procedure Merge(Src: TGenVector; Comparator: TCompareItems);
292
293 {** Returns index of the lowest item. }
MinPosnull294 function MinPos : Integer;
MinPosnull295 function MinPos(Comparator: TCompareItems) : Integer;
296
297 {** Returns index of the lowest item in the range [PosFrom..PosTo]. }
MinPosnull298 function MinPos(PosFrom, PosTo: Integer) : Integer;
MinPosnull299 function MinPos(PosFrom, PosTo: Integer;
300 Comparator: TCompareItems) : Integer;
301
302 {** Copies Count items from Src to Dst. }
303 procedure Move(Src, Dst, Count: Integer); override;
304
305 {** Inserts Count times Item at the begining of the container. }
306 procedure Prepend(const Item: _TItem_; Count: Integer = 1);
307
308 {** Inserts all the items of Src at the begining of the container. }
309 procedure PrependAll(Src: TGenVector);
310
311 {** Inserts all the items of Src in the range [PosFrom..PosTo] at the
312 begining of the container. }
313 procedure PrependRange(Src: TGenVector; PosFrom, PosTo: Integer);
314
315 procedure ReadFirstItem(out Value : _TItem_); inline;
316
317 procedure ReadItem(Position: Integer; out Value: _TItem_);
318
319 procedure ReadItemFast(Position: Integer; out Value: _TItem_); inline;
320
321 procedure ReadLastItem(out Value : _TItem_); inline;
322
323 {** Replaces items in range [Index..Index + Count - 1] by Value. }
324 procedure Replace(Index, Count: Integer; const Value: _TItem_);
325
326 {** Returns the index of the first item equal to Item or -1. }
ReverseFindIndexnull327 function ReverseFindIndex(const Item: _TItem_) : Integer;
ReverseFindIndexnull328 function ReverseFindIndex(const Item: _TItem_;
329 Comparator: TCompareItems) : Integer;
330
331 {** Returns a cursor on the first item equal to Item or NilCursor. The search
332 starts at the element From. }
ReverseFindIndexnull333 function ReverseFindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
ReverseFindIndexnull334 function ReverseFindIndex(const Item: _TItem_;
335 PosFrom: Integer; Comparator: TCompareItems) : Integer;
336
337 {** Assigns the value Value to the item at Position. }
338 procedure SetItem(Position: Integer; const Value: _TItem_); inline;
339
340 procedure SetItemFast(Position: Integer; const Value: _TItem_); inline;
341
342 {** Sorts the items. }
343 procedure Sort;
344 procedure Sort(Comparator: TCompareItems);
345
346 {** Sorts the items in the range [PosFrom..PosTo]. }
347 procedure Sort(PosFrom, PosTo: Integer);
348 procedure Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
349
350 {** Swaps the values of the items designated by I and J (no bounds check). }
351 procedure SwapFast(I, J: Integer); override;
352
353 {** Provides access to the items in the container. }
354 property Items[Index: Integer] : _TItem_ read GetItemFast
355 write SetItemFast; default;
356
357 {** Provides access to pointers on the items in the container. }
358 property ItemsPtr[Index: Integer] : PItem read GetItemPtrFast;
359
360 property OnCompareItems : TCompareItems read fOnCompareItems
361 write SetOnCompareItems;
362
363 property OnItemToString : TItemToString read fOnItemToString
364 write SetOnItemToString;
365 end;
366
367 { TGenDeque }
368
369 generic TGenDeque<_TItem_> = class(TAbstractVector)
370 public type
371 PItem = ^_TItem_;
372 TCompareItems = function (const A, B: _TItem_) : Integer of object;
373 TItemToString = function (const Item: _TItem_) : String of object;
374 TProcessItem = procedure(var Item: _TItem_) of object;
375 TEnumerator = specialize TGenEnumerator<_TItem_, Integer>;
376
377 strict private
378 fItems : array of _TItem_;
379 fOnCompareItems: TCompareItems;
380 fOnItemToString: TItemToString;
381 fStart : Integer;
382
383 procedure DecRank(var Rank: Integer); inline;
Equalsnull384 function Equals(Deque: TGenDeque; Comparator: TCompareItems): Boolean;
EnumeratorGetnull385 function EnumeratorGet(const Pos: Integer) : _TItem_;
EnumeratorNextnull386 function EnumeratorNext(var Pos: Integer) : Boolean;
387 procedure Fill(Index, Count: Integer; const Value: _TItem_);
GetItemPtrFastnull388 function GetItemPtrFast(Position: Integer): PItem;
389 procedure IncRank(var Rank: Integer); inline;
390 procedure IncreaseCapacity(ACapacity : Integer);
IndexToRanknull391 function IndexToRank(Index: Integer) : Integer; inline;
392 procedure InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
393 procedure Quicksort(Left, Right: Integer; Comparator: TCompareItems);
RankToIndexnull394 function RankToIndex(Rank: Integer) : Integer; inline;
395 class procedure RealMoveIndex(Src, Dst: TGenDeque;
396 SrcFirst, DstFirst, Count: Integer);
397 procedure RealMoveRank(Src, Dst, Count: Integer);
398 procedure ReduceCapacity(ACapacity : Integer);
399 procedure SetOnCompareItems(AValue: TCompareItems);
400 procedure SetOnItemToString(AValue: TItemToString);
401
402 protected
403 procedure InsertSpaceFast(Position, Count: Integer); override;
ItemToStringnull404 function ItemToString(Index: Integer) : String; override;
405 procedure SetCapacity(ACapacity : Integer); override;
406 public
407 {** Inserts Count times Item at the end of the container. }
408 procedure Append(const Item: _TItem_; Count: Integer = 1);
409
410 {** Inserts all the items of Src at the end of the container. }
411 procedure AppendAll(Src: TGenDeque);
412
413 {** Inserts all the items of Src in the range [PosFrom..PosTo] at the end of
414 the container. }
415 procedure AppendRange(Src: TGenDeque; PosFrom, PosTo: Integer);
416
417 {** Searches for Item using the binary search algorithm. Returns the index of
418 Item if its found. Otherwise, returns ( - InsertionPoint - 1 ).
419 InsertionPoint is the point at which the key would be inserted into the
420 container. }
BinarySearchnull421 function BinarySearch(const Item: _TItem_) : Integer;
BinarySearchnull422 function BinarySearch(const Item: _TItem_; Comparator: TCompareItems) : Integer;
423
424 {** Searches for Item in range [PosFrom..PosTo] using the binary search
425 algorithm. Returns the index of Item if its found. Otherwise, returns
426 ( - InsertionPoint - 1 ). InsertionPoint is the point at which the key
427 would be inserted into the range. }
BinarySearchnull428 function BinarySearch(const Item: _TItem_; PosFrom, PosTo: Integer) : Integer;
BinarySearchnull429 function BinarySearch(const Item: _TItem_;
430 PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
431
432 {** Returns true if the container contains Item. }
Containsnull433 function Contains(const Item: _TItem_) : Boolean;
Containsnull434 function Contains(const Item: _TItem_; Comparator: TCompareItems) : Boolean;
435
436 {** Creates an empty deque and sets his capacity to InitialCapacity. }
437 constructor Create(InitialCapacity: Integer = 16);
438
DefaultCompareItemsnull439 function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull440 function DefaultItemToString(const Item: _TItem_) : String; virtual;
441
442 {** Destroys the container. }
443 destructor Destroy; override;
444
445 {** If Obj = Self then returns @true, else if Obj is not a TGenDeque returns
446 false, else returns @true if Self and Obj contain the sames items. }
Equalsnull447 function Equals(Obj: TObject) : Boolean; override;
Equalsnull448 function Equals(Obj: TObject; Comparator: TCompareItems) : Boolean;
449
450 {** Returns the index of the first item equal to Item or -1. }
FindIndexnull451 function FindIndex(const Item: _TItem_) : Integer;
FindIndexnull452 function FindIndex(const Item: _TItem_; Comparator: TCompareItems) : Integer;
453
454 {** Returns a cursor on the first item equal to Item or NilCursor. The search
455 starts at the element From. }
FindIndexnull456 function FindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
FindIndexnull457 function FindIndex(const Item: _TItem_; PosFrom: Integer; Comparator: TCompareItems) : Integer;
458
459 {** Returns the first Item. }
FirstItemnull460 function FirstItem : _TItem_; inline;
461
GetEnumeratornull462 function GetEnumerator : TEnumerator;
463
GetItemFastnull464 function GetItemFast(Position: Integer) : _TItem_; inline;
465
466 {** Returns item at position Position. }
GetItemnull467 function GetItem(Position: Integer) : _TItem_; inline;
468
469 {** Returns a pointer designating item at position Position. }
GetItemPtrnull470 function GetItemPtr(Position: Integer): PItem;
471
472 {** Inserts Count times Item before Before. }
473 procedure Insert(Before: Integer; const Item: _TItem_;
474 Count: Integer = 1);
475
476 {** Inserts all the items of Src before Before. }
477 procedure InsertAll(Before: Integer; Src: TGenDeque);
478
479 {** Inserts before Before all the items of Src in the range
480 [PosFrom..PosTo]. }
481 procedure InsertRange(Before: Integer; Src: TGenDeque;
482 PosFrom, PosTo: Integer);
483
484 {** Returns true if the items are sorted. }
IsSortednull485 function IsSorted: Boolean;
IsSortednull486 function IsSorted(Comparator: TCompareItems): Boolean;
487
488 {** Invokes Process on each items. }
489 procedure Iterate(Process: TProcessItem);
490
491 {** Invokes Process on each items in range [PosFrom..PosTo]. }
492 procedure Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
493
494 {** Returns the last Item. }
LastItemnull495 function LastItem: _TItem_; inline;
496
497 {** Returns index of the greatest item. }
MaxPosnull498 function MaxPos : Integer;
MaxPosnull499 function MaxPos(Comparator: TCompareItems) : Integer;
500
501 {** Returns index of the greatest item in the range [PosFrom..PosTo]. }
MaxPosnull502 function MaxPos(PosFrom, PosTo: Integer) : Integer;
MaxPosnull503 function MaxPos(PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
504
505 {** Removes items from Src and inserts them into Self. Afterwards, Self
506 contains the union of the items that were initially in Src and Self. Src
507 is left empty. If Self and Src are initially sorted, then Self is
508 sorted. }
509 procedure Merge(Src: TGenDeque);
510 procedure Merge(Src: TGenDeque; Comparator: TCompareItems);
511
512 {** Returns index of the lowest item. }
MinPosnull513 function MinPos : Integer;
MinPosnull514 function MinPos(Comparator: TCompareItems) : Integer;
515
516 {** Returns index of the lowest item in the range [PosFrom..PosTo]. }
MinPosnull517 function MinPos(PosFrom, PosTo: Integer) : Integer;
MinPosnull518 function MinPos(PosFrom, PosTo: Integer; Comparator: TCompareItems) : Integer;
519
520 {** Copies Count items from Src to Dst. }
521 procedure Move(Src, Dst, Count: Integer); override;
522
523 {** Inserts Count times Item at the begining of the container. }
524 procedure Prepend(const Item: _TItem_; Count: Integer = 1);
525
526 {** Inserts all the items of Src at the begining of the container. }
527 procedure PrependAll(Src: TGenDeque);
528
529 {** Inserts all the items of Src in the range [PosFrom..PosTo] at the
530 begining of the container. }
531 procedure PrependRange(Src: TGenDeque; PosFrom, PosTo: Integer);
532
533 procedure ReadFirstItem(out Value : _TItem_); inline;
534
535 procedure ReadItem(Position: Integer; out Value: _TItem_);
536
537 procedure ReadItemFast(Position: Integer; out Value: _TItem_); inline;
538
539 procedure ReadLastItem(out Value : _TItem_); inline;
540
541 {** Replaces items in range [Index..Index + Count - 1] by Value. }
542 procedure Replace(Index, Count: Integer; const Value: _TItem_);
543
544 {** Returns the index of the first item equal to Item or -1. }
ReverseFindIndexnull545 function ReverseFindIndex(const Item: _TItem_) : Integer;
ReverseFindIndexnull546 function ReverseFindIndex(const Item: _TItem_; Comparator: TCompareItems) : Integer;
547
548 {** Returns a cursor on the first item equal to Item or NilCursor. The search
549 starts at the element From. }
ReverseFindIndexnull550 function ReverseFindIndex(const Item: _TItem_; PosFrom: Integer) : Integer;
ReverseFindIndexnull551 function ReverseFindIndex(const Item: _TItem_; PosFrom: Integer;
552 Comparator: TCompareItems) : Integer;
553
554 {** Assigns the value Value to the item at Position. }
555 procedure SetItem(Position: Integer; const Value: _TItem_); inline;
556
557 procedure SetItemFast(Position: Integer; const Value: _TItem_); inline;
558
559 {** Sorts the items. }
560 procedure Sort;
561 procedure Sort(Comparator: TCompareItems);
562
563 {** Sorts the items in the range [PosFrom..PosTo]. }
564 procedure Sort(PosFrom, PosTo: Integer);
565 procedure Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
566
567 procedure SwapFast(I, J: Integer); override;
568
569 {** Provides access to the items in the container. }
570 property Items[Index: Integer] : _TItem_ read GetItemFast
571 write SetItemFast; default;
572
573 {** Provides access to pointers on the items in the container. }
574 property ItemsPtr[Index: Integer] : PItem read GetItemPtrFast;
575
576 property OnCompareItems : TCompareItems read fOnCompareItems
577 write SetOnCompareItems;
578
579 property OnItemToString : TItemToString read fOnItemToString
580 write SetOnItemToString;
581 end;
582
583 TAbstractList = class;
584
585 { TListCursor }
586
587 TListCursor = object
588 strict private
589 fList : TAbstractList;
590 fNode : Pointer;
591
592 public
593 {** Check if the cursors designate the same item. }
Equalsnull594 function Equals(const Cursor: TListCursor) : Boolean; inline;
595
596 {** Check if the cursors designate an item. }
HasItemnull597 function HasItem: Boolean; inline;
598
599 constructor Init(AList : TAbstractList; ANode: Pointer);
600
601 {** Returns true if the cursor designates the first element. }
IsFirstnull602 function IsFirst: Boolean; inline;
603
604 {** Returns true if the cursor designates the last element. }
IsLastnull605 function IsLast: Boolean; inline;
606
607 {** Equivalent to not HasItem. }
IsNilnull608 function IsNil: Boolean; inline;
609
610 {** If cursor is nil then do nothing, else if cursor is last then cursor
611 becomes nil cursor, otherwise move cursor to the next item. }
612 procedure MoveNext; inline;
613
614 {** If cursor is nil then do nothing, else if cursor is first then cursor
615 becomes nil cursor, otherwise move cursor to the previous item. }
616 procedure MovePrevious; inline;
617
618 {** The designated List. }
619 property List : TAbstractList read fList;
620
621 {** The designated node. }
622 property Node : Pointer read fNode write fNode;
623 end;
624
625 { TAbstractList }
626
627 TAbstractList = class(TContainer)
628 protected
629 procedure CheckValid(const Cursor: TListCursor);
630 procedure CheckNotNil(const Cursor: TListCursor);
CursorIsFirstnull631 function CursorIsFirst(const Cursor: TListCursor) : Boolean; virtual; abstract;
CursorIsLastnull632 function CursorIsLast(const Cursor: TListCursor) : Boolean; virtual; abstract;
633 procedure CursorMoveNext(var Cursor: TListCursor); virtual; abstract;
634 procedure CursorMovePrev(var Cursor: TListCursor); virtual; abstract;
635 end;
636
637 { TGenList }
638
639 generic TGenList<_TItem_> = class(TAbstractList)
640 public type
641 PItem = ^_TItem_;
642 TCompareItems = function (const A, B: _TItem_) : Integer of object;
643 TItemToString = function (const Item: _TItem_) : String of object;
644 TProcessItem = procedure(var Item: _TItem_) of object;
645 TEnumerator = specialize TGenEnumerator<_TItem_, TListCursor>;
646
647 strict private type
648 PNode = ^TNode;
649 TNode = record
650 Item : _TItem_;
651 Next, Previous : PNode;
652 end;
653
654 strict private
655 fHead : PNode;
656 fOnCompareItems: TCompareItems;
657 fOnItemToString: TItemToString;
658 fTail : PNode;
659 fSize : Integer;
660 fNilCursor : TListCursor;
661
662 procedure DeleteNodesBackward(From: PNode; Count: Integer);
663 procedure DeleteNodesBetween(NodeFrom, NodeTo: PNode);
664 procedure DeleteNodesForward(From: PNode; Count: Integer);
EnumeratorGetnull665 function EnumeratorGet(const Pos: TListCursor) : _TItem_;
EnumeratorNextnull666 function EnumeratorNext(var Pos: TListCursor) : Boolean;
Equalsnull667 function Equals(List: TGenList; Comparator: TCompareItems) : Boolean;
GetItemFastnull668 function GetItemFast(const Position: TListCursor) : _TItem_; inline;
GetItemPtrFastnull669 function GetItemPtrFast(const Position: TListCursor) : PItem; inline;
670 procedure InsertItem(const Item: _TItem_; Pos: PNode; Count: Integer);
671 procedure Partition(Pivot, Back: PNode; Comparator: TCompareItems);
672 procedure RealSort(Front, Back: PNode; Comparator: TCompareItems);
673 procedure SetOnCompareItems(AValue: TCompareItems);
674 procedure SetOnItemToString(AValue: TItemToString);
675 procedure SpliceNodes(Before, PosFrom, PosTo: PNode);
676
677 protected
CursorIsFirstnull678 function CursorIsFirst(const Cursor: TListCursor) : Boolean; override;
CursorIsLastnull679 function CursorIsLast(const Cursor: TListCursor) : Boolean; override;
680 procedure CursorMoveNext(var Cursor: TListCursor); override;
681 procedure CursorMovePrev(var Cursor: TListCursor); override;
682
683 public
684 {** Inserts Count times Item at the end of the container. }
685 procedure Append(const Item: _TItem_; Count: Integer = 1);
686
687 {** Inserts all the items of Src at the end of the container. }
688 procedure AppendAll(Src: TGenList);
689
690 {** Inserts all the items of Src in the range [PosFrom..PosTo] at the end of
691 the container. }
692 procedure AppendRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
693
694 {** Removes all the items from the container. }
695 procedure Clear;
696
697 {** Returns true if the container contains Item. }
Containsnull698 function Contains(const Item: _TItem_) : Boolean;
Containsnull699 function Contains(const Item: _TItem_; Comparator: TCompareItems) : Boolean;
700
701 {** Creates an empty list. }
702 constructor Create;
703
DefaultCompareItemsnull704 function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull705 function DefaultItemToString(const Item: _TItem_) : String; virtual;
706
707 {** Deletes Count items begining at Position and then sets Position to
708 NilCursor. }
709 procedure Delete(var Position: TListCursor; Count: Integer = 1);
710
711 {** Deletes the first Count items. }
712 procedure DeleteFirst(Count: Integer = 1);
713
714 {** Deletes the last Count items. }
715 procedure DeleteLast(Count: Integer = 1);
716
717 {** Deletes all items in the range [PosFrom..PosTo]. }
718 procedure DeleteRange(const PosFrom, PosTo: TListCursor);
719
720 {** Destroys the container. }
721 destructor Destroy; override;
722
723 {** If Obj = Self then returns true, else if Obj is not a TGenList returns false,
724 else returns true if Self and Obj contain the sames items. }
Equalsnull725 function Equals(Obj: TObject) : Boolean; override;
Equalsnull726 function Equals(Obj: TObject; Comparator: TCompareItems) : Boolean;
727
728 {** Returns a cursor on the first item equal to Item or NilCursor. }
Findnull729 function Find(const Item: _TItem_) : TListCursor;
730
Findnull731 function Find(const Item: _TItem_; Comparator: TCompareItems) : TListCursor;
732
733 {** Returns a cursor on the first item equal to Item or NilCursor.The search
734 starts at the first element if Position is NilCursor, and at the element
735 designated by Position otherwise. }
Findnull736 function Find(const Item: _TItem_; const Position: TListCursor) : TListCursor;
737
Findnull738 function Find(const Item: _TItem_; const Position: TListCursor; Comparator: TCompareItems): TListCursor;
739
740 {** Returns a cursor that designates the first element of the container or
741 NilCursor if the container is empty. }
Firstnull742 function First: TListCursor;
743
744 {** Returns the first Item. }
FirstItemnull745 function FirstItem : _TItem_; inline;
746
747 {** If Index is not in the range [0..Size - 1], then returns NilCursor.
748 Otherwise, returns a cursor designating the item at position Index. }
GetCursornull749 function GetCursor(Index: Integer): TListCursor;
750
GetEnumeratornull751 function GetEnumerator : TEnumerator;
752
753 {** Returns the item designated by Position. }
GetItemnull754 function GetItem(const Position: TListCursor) : _TItem_; inline;
755
756 {** Returns a pointer designating the item designated by Position. }
GetItemPtrnull757 function GetItemPtr(const Position: TListCursor) : PItem; inline;
758
759 {** Inserts Count times Item before Before. }
760 procedure Insert(const Before: TListCursor; const Item: _TItem_;
761 Count: Integer = 1);
762
763 {** Inserts Count times Item before Before. Position designates the first
764 newly-inserted element. }
765 procedure Insert(const Before: TListCursor; const Item: _TItem_;
766 out Position: TListCursor; Count: Integer);
767
768 {** Inserts all the items of Src before Before. }
769 procedure InsertAll(const Before: TListCursor; Src: TGenList);
770
771 {** Inserts before Before all the items of Src in the range
772 [PosFrom..PosTo]. }
773 procedure InsertRange(const Before : TListCursor; Src: TGenList;
774 const PosFrom, PosTo: TListCursor);
775
776 {** Returns true if the list is empty. }
IsEmptynull777 function IsEmpty: Boolean; inline;
778
779 {** Returns @true if the items are sorted. }
IsSortednull780 function IsSorted : Boolean;
781
IsSortednull782 function IsSorted(Comparator: TCompareItems) : Boolean;
783
784 procedure Iterate(Process: TProcessItem);
785
786 procedure Iterate(Process: TProcessItem; const PosFrom, PosTo: TListCursor);
787
788 {** Returns a cursor that designates the last element of the container or
789 NilCursor if the container is empty. }
Lastnull790 function Last: TListCursor;
791
792 {** Returns the last Item. }
LastItemnull793 function LastItem: _TItem_; inline;
794
795 {** Removes items from Src and inserts them into Self. Afterwards, Self
796 contains the union of the items that were initially in Src and Self. Src
797 is left empty. If Self and Src are initially sorted, then Self is
798 sorted. }
799 procedure Merge(Src: TGenList);
800 procedure Merge(Src: TGenList; Comparator: TCompareItems);
801
802 {** Inserts Count times Item at the begining of the container. }
803 procedure Prepend(const Item: _TItem_; Count: Integer = 1);
804
805 {** Inserts all the items of Src at the begining of the container. }
806 procedure PrependAll(Src: TGenList);
807
808 {** Inserts all the items of Src in the range [PosFrom..PosTo] at the
809 begining of the container. }
810 procedure PrependRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
811
812 procedure ReadFirstItem(out Value : _TItem_); inline;
813
814 procedure ReadItem(const Position: TListCursor; out Value: _TItem_);
815
816 procedure ReadItemFast(const Position: TListCursor; out Value: _TItem_); inline;
817
818 procedure ReadLastItem(out Value : _TItem_); inline;
819
820 {** Replaces items in range [Position..Position + Count - 1] by Value. }
821 procedure Replace(const Position: TListCursor; Count: Integer;
822 const Value: _TItem_);
823
824 {** Reorders the items in reverse order. }
825 procedure Reverse;
826
827 {** Returns a cursor on the first item equal to Item or NilCursor. }
ReverseFindnull828 function ReverseFind(const Item: _TItem_) : TListCursor;
ReverseFindnull829 function ReverseFind(const Item: _TItem_; Comparator: TCompareItems): TListCursor;
830
831 {** Returns a cursor on the first item equal to Item or NilCursor.The search
832 starts at the last element if Position is NilCursor, and at the element
833 designated by Position otherwise. }
ReverseFindnull834 function ReverseFind(const Item: _TItem_; const Position: TListCursor) : TListCursor;
ReverseFindnull835 function ReverseFind(const Item: _TItem_; const Position: TListCursor;
836 Comparator: TCompareItems) : TListCursor;
837
838 {** Reorders the items in the range [PosFrom..PosTo] in reverse order. }
839 procedure ReverseRange(const PosFrom, PosTo: TListCursor);
840
841 {** Assigns the value Value to the item designated by Position. }
842 procedure SetItem(const Position: TListCursor; const Value: _TItem_);
843
844 procedure SetItemFast(const Position: TListCursor; const Value: _TItem_); inline;
845
846 {** Sorts the items. }
847 procedure Sort;
848 procedure Sort(Comparator: TCompareItems);
849
850 {** Sorts the items in the range [PosFrom..PosTo]. }
851 procedure Sort(const PosFrom, PosTo: TListCursor);
852 procedure Sort(const PosFrom, PosTo: TListCursor; Comparator: TCompareItems);
853
854 {** Removes all items of Src and moves them to Self before Before. }
855 procedure Splice(const Before: TListCursor; Src: TGenList);
856
857 {** Removes from Src the item designated by Position and moves it to Self
858 before Before. }
859 procedure Splice(const Before: TListCursor; Src: TGenList;
860 const Position: TListCursor);
861
862 {** Removes all items of Src in the range [SrcFrom..SrcTo] and moves them to
863 Self before Before. }
864 procedure Splice(const Before: TListCursor; Src: TGenList;
865 const SrcFrom, SrcTo: TListCursor);
866
867 {** Swaps the values of the items designated by I and J. }
868 procedure Swap(const I, J: TListCursor);
869
870 {** Swaps the nodes designated by I and J. }
871 procedure SwapLinks(const I, J: TListCursor);
872
873 {** Return a string representation for the container. }
ToStringnull874 function ToString : String; override;
875
876 {** Provides access to the items in the container. }
877 property Items[const Index: TListCursor] : _TItem_
878 read GetItemFast write SetItemFast; default;
879
880 {** Provides access to pointers on the items in the container. }
881 property ItemsPtr[const Index: TListCursor] : PItem read GetItemPtrFast;
882
883 {** A nil cursor. }
884 property NilCursor: TListCursor read fNilCursor;
885
886 property OnCompareItems : TCompareItems read fOnCompareItems
887 write SetOnCompareItems;
888
889 property OnItemToString : TItemToString read fOnItemToString
890 write SetOnItemToString;
891
892 {** Number of elements in the list. }
893 property Size: Integer read fSize;
894 end;
895
896 { TGenPriorityQueue }
897
898 generic TGenPriorityQueue<_TItem_> = class(TContainer)
899 public type
900 TCompareItems = function (const A, B: _TItem_) : Integer of object;
901
902 strict private
903 fCapacity : Integer;
904 fItems : array of _TItem_;
905 fOnCompareItems: TCompareItems;
906 fSize : Integer;
907
908 procedure SetOnCompareItems(AValue: TCompareItems);
909 procedure MoveDown(Index: Integer; const Item: _TItem_);
910 procedure MoveUp(Index: Integer; const Item: _TItem_);
911
912 public
913 {** Empty the queue of all items. }
914 procedure Clear;
915
916 {** Creates an empty priority queue. }
917 constructor Create(InitialCapacity : Integer = 16);
918
DefaultCompareItemsnull919 function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
920
921 {** Returns true if the priority queue is empty. }
IsEmptynull922 function IsEmpty: Boolean; inline;
923
924 {** Frees unused memory. }
925 procedure Pack;
926
927 {** Removes the item from the top of the stack. }
928 procedure Pop;
929
930 {** Adds Item to the top of the stack. }
931 procedure Push(const Item: _TItem_);
932
933 procedure ReadTop(out Value: _TItem_);
934
935 {** If necessary, increases the capacity of the container to ensure that it
936 can hold at least MinCapacity items. }
937 procedure Reserve(MinCapacity : Integer);
938
939 {** Returns the item at the top of the stack. }
Topnull940 function Top : _TItem_;
941
942 {** Capacity of the container. }
943 property Capacity : Integer read fCapacity;
944
945 property OnCompareItems : TCompareItems read fOnCompareItems write SetOnCompareItems;
946
947 {** Number of elements. }
948 property Size: Integer read fSize;
949 end;
950
951 { TGenQueue }
952
953 generic TGenQueue<_TItem_, _TContainer_> = class(TContainer)
954 private
955 fData : _TContainer_;
GetSizenull956 function GetSize: Integer; inline;
957
958 public
959 {** Add the item to the back of the queue. }
960 procedure Append(const Item: _TItem_);
961
962 {** Empty the queue of all items. }
963 procedure Clear;
964
965 {** Creates an empty queue. }
966 constructor Create;
967
968 {** Destroys the container. }
969 destructor Destroy; override;
970
971 {** Returns a copy of the item at the front of the queue. }
Frontnull972 function Front : _TItem_;
973
974 {** Returns true if the queue is empty. }
IsEmptynull975 function IsEmpty: Boolean; inline;
976
977 {** Removes the item from the front of the queue. }
978 procedure Pop;
979
980 procedure ReadFront(out Value: _TItem_);
981
982 {** Number of items. }
983 property Size : Integer read GetSize;
984 end;
985
986 { TGenStack }
987
988 generic TGenStack<_TItem_, _TContainer_> = class(TContainer)
989 private
990 fData : _TContainer_;
GetSizenull991 function GetSize: Integer; inline;
992
993 public
994 {** Removes all the items from the stack. }
995 procedure Clear;
996
997 {** Creates an empty stack. }
998 constructor Create;
999
1000 {** Destroys the stack. }
1001 destructor Destroy; override;
1002
1003 {** Returns true if the stack is empty. }
IsEmptynull1004 function IsEmpty: Boolean; inline;
1005
1006 {** Removes the item from the top of the stack. }
1007 procedure Pop;
1008
1009 {** Adds Item to the top of the stack. }
1010 procedure Push(const Item: _TItem_);
1011
1012 procedure ReadTop(out Value : _TItem_);
1013
1014 {** Returns the item at the top of the stack. }
Topnull1015 function Top : _TItem_;
1016
1017 {** Number of items. }
1018 property Size : Integer read GetSize;
1019 end;
1020
1021 TAbstractHashMap = class;
1022
1023 { THashMapCursor }
1024
1025 THashMapCursor = object
1026 strict private
1027 fBucket : Integer;
1028 fHashMap : TAbstractHashMap;
1029 fEntry : Pointer;
1030 fPrevious : Pointer;
1031
1032 public
1033 {** Check if the cursors designate the same item. }
Equalsnull1034 function Equals(const Cursor: THashMapCursor) : Boolean; inline;
1035
1036 {** Check if the cursors designate an item. }
HasItemnull1037 function HasItem: Boolean; inline;
1038
1039 {** Constructor. }
1040 constructor Init(HashMap : TAbstractHashMap; BucketNum: Integer;
1041 AEntry, APrevious: Pointer);
1042
1043 {** Returns true if the cursor designates the first element. }
IsFirstnull1044 function IsFirst: Boolean; inline;
1045
1046 {** Returns true if the cursor designates the last element. }
IsLastnull1047 function IsLast: Boolean; inline;
1048
1049 {** Equivalent to not HasItem. }
IsNilnull1050 function IsNil: Boolean; inline;
1051
1052 {** If cursor is nil then do nothing, else if cursor is last then cursor
1053 becomes nil cursor, otherwise move cursor to the next item. }
1054 procedure MoveNext; inline;
1055
1056 {** Designated bucket. }
1057 property Bucket : Integer read fBucket write fBucket;
1058
1059 property HashMap : TAbstractHashMap read fHashMap;
1060
1061 {** Designated entry. }
1062 property Entry : Pointer read fEntry write fEntry;
1063
1064 property Previous : Pointer read fPrevious write fPrevious;
1065 end;
1066
1067 { TAbstractHashMap }
1068
1069 TAbstractHashMap = class(TContainer)
1070 protected
CursorIsFirstnull1071 function CursorIsFirst(const Cursor: THashMapCursor): Boolean; virtual; abstract;
CursorIsLastnull1072 function CursorIsLast(const Cursor: THashMapCursor): Boolean; virtual; abstract;
1073 procedure CursorMoveNext(const Cursor: THashMapCursor); virtual; abstract;
1074 end;
1075
1076 { TGenHashMap }
1077
1078 generic TGenHashMap<_TKey_, _TItem_> = class(TAbstractHashMap)
1079 public type
1080 THashKey = function (const Key: _TKey_) : Integer of object;
1081 TItemToString = function (const Item: _TItem_) : String of object;
1082 TKeysEqual = function (const A, B: _TKey_) : Boolean of object;
1083 TKeyToString = function (const Key: _TKey_) : String of object;
1084 TEnumerator = specialize TGenEnumerator<_TItem_, THashMapCursor>;
1085
1086 private type
1087 PPEntry = ^PEntry;
1088 PEntry = ^TEntry;
1089 TEntry = record
1090 Key : _TKey_;
1091 Value : _TItem_;
1092 Next : PEntry;
1093 end;
1094
1095 strict private
1096 fBucketCount : Integer;
1097 fBuckets : PPEntry;
1098 fFirstNonEmptyBucket: Integer;
1099 fLastNonEmptyBucket : Integer;
1100 fMaxBucketCount : Integer;
1101 fMaxLoadFactor : Real;
1102 fNilCursor : THashMapCursor;
1103 fOnHashKey: THashKey;
1104 fOnItemToString: TItemToString;
1105 fOnKeysEqual: TKeysEqual;
1106 fOnKeyToString: TKeyToString;
1107 fSize : Integer;
1108 fThreshold : Integer;
1109
1110 procedure AppendBuckets(Count: Integer);
CollectEntriesnull1111 function CollectEntries : PEntry;
1112
1113 procedure DeleteEntry(Bucket : Integer; Entry, Previous: PEntry);
1114 procedure DisposeEntries(E: PEntry);
EnumeratorGetnull1115 function EnumeratorGet(const Pos: THashMapCursor) : _TItem_;
EnumeratorNextnull1116 function EnumeratorNext(var Pos: THashMapCursor) : Boolean;
FindEntrynull1117 function FindEntry(Bucket: Integer; const Key: _TKey_) : PEntry;
FindEntrynull1118 function FindEntry(Bucket: Integer; const Key: _TKey_; out Previous : PEntry) : PEntry;
GetEntrynull1119 function GetEntry(const Key: _TKey_): PEntry; inline;
GetEntryAtnull1120 function GetEntryAt(const Position: THashMapCursor): PEntry; inline;
GetLoadFactornull1121 function GetLoadFactor: Real;
IndexFornull1122 function IndexFor(Hash: Integer) : Integer; inline;
1123 procedure InsertCollectedEntries(CollectedEntries: PEntry);
1124 procedure InsertEntry(Bucket: Integer; Entry: PEntry);
1125 procedure InsertEntry(Entry, Before: PEntry);
NextNonEmptyBucketnull1126 function NextNonEmptyBucket(Bucket: Integer) : Integer;
NewEntrynull1127 function NewEntry(const Key: _TKey_; const Value: _TItem_) : PEntry; inline;
1128 procedure NilifyBuckets(BucketFrom, Count: Integer);
PreviousNonEmptyBucketnull1129 function PreviousNonEmptyBucket(Bucket: Integer) : Integer;
1130 procedure Resize(NewCapacity: Integer);
1131 procedure SetOnHashKey(AValue: THashKey);
1132 procedure SetOnItemToString(AValue: TItemToString);
1133 procedure SetOnKeysEqual(AValue: TKeysEqual);
1134 procedure SetOnKeyToString(AValue: TKeyToString);
1135
1136 protected
CursorIsFirstnull1137 function CursorIsFirst(const Cursor: THashMapCursor): Boolean; override;
CursorIsLastnull1138 function CursorIsLast(const Cursor: THashMapCursor): Boolean; override;
1139 procedure CursorMoveNext(const Cursor: THashMapCursor); override;
1140 public
1141 {** Removes all the items from the container. }
1142 procedure Clear;
1143
1144 {** Returns true if the container contains Key. }
Containsnull1145 function Contains(const Key : _TKey_) : Boolean;
1146
1147 {** Creates an empty hash map and sets his capacity to InitialCapacity. }
1148 constructor Create(InitialCapacity: Integer = MIN_BUCKET_COUNT);
1149
1150 {** Creates an empty hash map and sets his load factor to MaxLoadFact. }
1151 constructor Create(MaxLoadFact: Real);
1152
1153 {** Creates an empty hash map and sets his capacity to InitialCapacity and
1154 his load factor to MaxLoadFact. }
1155 constructor Create(InitialCapacity: Integer; MaxLoadFact: Real);
1156
DefaultHashKeynull1157 function DefaultHashKey(const Key: _TKey_) : Integer; virtual;
DefaultItemToStringnull1158 function DefaultItemToString(const Item: _TItem_) : String; virtual;
DefaultKeysEqualnull1159 function DefaultKeysEqual(const A, B: _TKey_) : Boolean; virtual;
DefaultKeyToStringnull1160 function DefaultKeyToString(const Key: _TKey_) : String; virtual;
1161
1162 {** Checks if an item with the key Key is present. If a match is found,
1163 removes the item from the map. Otherwise raises an exception. }
1164 procedure Delete(const Key: _TKey_);
1165
1166 {** Deletes the item designated by Position. }
1167 procedure DeleteAt(const Position: THashMapCursor);
1168
1169 {** Destroys the container. }
1170 destructor Destroy; override;
1171
1172 {** Checks if an item with the key Key is present. If a match is found,
1173 removes the item from the map. }
1174 procedure Exclude(const Key : _TKey_);
1175
1176 {** Checks if an item associated with Key is present. If a match is found,
1177 a cursor designating the matching item is returned. Otherwise,
1178 NilCursor is returned. }
Findnull1179 function Find(const Key : _TKey_) : THashMapCursor;
1180
1181 {** Returns a cursor that designates the first element of the container
1182 or NilCursor if the container is empty. }
Firstnull1183 function First: THashMapCursor;
1184
GetEnumeratornull1185 function GetEnumerator : TEnumerator;
1186
GetItemnull1187 function GetItem(const Key: _TKey_): _TItem_;
1188
GetItemAtnull1189 function GetItemAt(const Position: THashMapCursor): _TItem_;
1190
GetKeyAtnull1191 function GetKeyAt(const Position : THashMapCursor) : _TKey_;
1192
1193 {** Inserts Key and Value into the map. If an entry with the same Key is
1194 already in the map, then the old value is replaced. }
1195 procedure Include(const Key : _TKey_; const Value: _TItem_);
1196
1197 {** Inserts Key and Value into the map. If an entry with the same Key is
1198 already in the map, then an exception is raised. }
1199 procedure Insert(const Key : _TKey_; const Value: _TItem_);
1200
1201 {** If an entry with the key Key is already in the map, then Inserted is set
1202 to false. Otherwise, Insert inserts Key and Value into the map and sets
1203 Inserted to true. }
1204 procedure Insert(const Key : _TKey_; const Value: _TItem_;
1205 out Inserted: Boolean);
1206
1207 {** Returns true if the container is empty. }
IsEmptynull1208 function IsEmpty: Boolean; inline;
1209
1210 procedure ReadItem(const Key: _TKey_; out Value: _TItem_);
1211 procedure ReadItemAt(const Position: THashMapCursor; out Value: _TItem_);
1212 procedure ReadKeyAt(const Position : THashMapCursor; out Key: _TKey_);
1213
1214 {** Checks if an entry with the key Key is present. If a match is found,
1215 assigns Key and Value to the matching entry. Otherwise, an exception is
1216 raised. }
1217 procedure Replace(const Key : _TKey_; const Value: _TItem_);
1218
1219 procedure SetItemAt(const Position: THashMapCursor; AValue: _TItem_);
1220
1221 {** Return a string representation for the container. }
ToStringnull1222 function ToString : String; override;
1223
1224 property BucketCount : Integer read fBucketCount;
1225
1226 {** Provides access to the items in the container. }
1227 property ItemAt[const Position: THashMapCursor] : _TItem_ read GetItemAt
1228 write SetItemAt;
1229
1230 {** Provides access to the items in the container. }
1231 property Items[const Key: _TKey_] : _TItem_ read GetItem write Include;
1232 default;
1233
1234 {** Provides access to the keys in the container. }
1235 property Keys[const Position: THashMapCursor] : _TKey_ read GetKeyAt;
1236
1237 property LoadFactor : Real read GetLoadFactor;
1238
1239 property MaxBucketCount : Integer read fMaxBucketCount;
1240
1241 property MaxLoadFactor : Real read fMaxLoadFactor;
1242
1243 {** A nil cursor. }
1244 property NilCursor: THashMapCursor read fNilCursor;
1245
1246 property OnHashKey : THashKey read fOnHashKey write SetOnHashKey;
1247 property OnItemToString : TItemToString read fOnItemToString write SetOnItemToString;
1248 property OnKeysEqual : TKeysEqual read fOnKeysEqual write SetOnKeysEqual;
1249 property OnKeyToString : TKeyToString read fOnKeyToString write SetOnKeyToString;
1250
1251 {** Number of items. }
1252 property Size : Integer read fSize;
1253 end;
1254
1255 TAbstractHashSet = class(TContainer)
1256 end;
1257
1258 { THashSetCursor }
1259
1260 THashSetCursor = object
1261 strict private
1262 fHashSet : TAbstractHashSet;
1263 fPos : THashMapCursor;
1264
1265 public
1266 {** Check if the cursors designate the same item. }
Equalsnull1267 function Equals(const Cursor: THashSetCursor) : Boolean;
1268
1269 {** Check if the cursors designate an item. }
HasItemnull1270 function HasItem: Boolean; inline;
1271
1272 {** Constructor. }
1273 constructor Init(HashSet : TAbstractHashSet; const APos: THashMapCursor);
1274
1275 {** Returns true if the cursor designates the first element. }
IsFirstnull1276 function IsFirst: Boolean; inline;
1277
1278 {** Returns true if the cursor designates the last element. }
IsLastnull1279 function IsLast: Boolean; inline;
1280
1281 {** Equivalent to (not HasItem). }
IsNilnull1282 function IsNil: Boolean; inline;
1283
1284 {** If cursor is nil then do nothing, else if is last then cursor becomes nil
1285 cursor, otherwise move cursor to the next item. }
1286 procedure MoveNext;
1287
1288 property HashSet : TAbstractHashSet read fHashSet;
1289
1290 {** Designated entry. }
1291 property Pos : THashMapCursor read fPos;
1292 end;
1293
1294 { TGenHashSet }
1295
1296 generic TGenHashSet<_TItem_> = class(TAbstractHashSet)
1297 strict private type
1298 TItemEquals = function (const A, B: _TItem_) : Boolean of object;
1299 TItemToString = function (const Item: _TItem_) : String of object;
1300 THashItem = function (const Item: _TItem_) : Integer of object;
1301 TMap = specialize TGenHashMap<_TItem_, Integer>;
1302 TEnumerator = specialize TGenEnumerator<_TItem_, THashSetCursor>;
1303
1304 strict private
1305 fMap : TMap;
1306 fNilCursor : THashSetCursor;
1307
EnumeratorGetnull1308 function EnumeratorGet(const Pos: THashSetCursor) : _TItem_;
EnumeratorNextnull1309 function EnumeratorNext(var Pos: THashSetCursor) : Boolean;
1310 procedure ExchangeContent(ASet: TGenHashSet);
GetItemToStringnull1311 function GetItemToString: TItemToString;
GetOnHashItemnull1312 function GetOnHashItem: THashItem;
GetOnItemsEqualnull1313 function GetOnItemsEqual: TItemEquals;
GetSizenull1314 function GetSize: Integer; inline;
1315 procedure SetOnHashItem(AValue: THashItem);
1316 procedure SetOnItemsEqual(AValue: TItemEquals);
1317 procedure SetOnItemToString(AValue: TItemToString);
1318
1319 public
1320 {** Removes all the items from the container. }
1321 procedure Clear;
1322
1323 {** Returns true if the container contains Item. }
Containsnull1324 function Contains(const Item: _TItem_) : Boolean;
1325
1326 {** Creates an empty hash set and sets his capacity to InitialCapacity. }
1327 constructor Create(InitialCapacity: Integer = 16);
1328
1329 {** Creates an empty hash set and sets his load factor to LoadFact. }
1330 constructor Create(LoadFact: Real);
1331
1332 {** Creates an empty hash set and sets his capacity to InitialCapacity and
1333 his load factor to LoadFact. }
1334 constructor Create(InitialCapacity: Integer; LoadFact: Real);
1335
DefaultItemsEqualnull1336 function DefaultItemsEqual(const A, B: _TItem_) : Boolean; virtual;
DefaultItemToStringnull1337 function DefaultItemToString(const Item: _TItem_) : String; virtual;
DefaultHashItemnull1338 function DefaultHashItem(const Item: _TItem_) : Integer; virtual;
1339
1340 {** Checks if Item is present in the container. If a match is found, removes
1341 the element from the set. Otherwise, raises an exception. }
1342 procedure Delete(const Item: _TItem_);
1343
1344 {** Deletes the item designated by Position. }
1345 procedure DeleteAt(const Position: THashSetCursor);
1346
1347 destructor Destroy; override;
1348
1349 {** Clears Self and then adds to Self all the items of Left that are not
1350 present in Right. }
1351 procedure Difference(Left, Right: TGenHashSet);
1352
1353 {** Checks if Item is present in the container. If a match is found, removes
1354 the item from the set. }
1355 procedure Exclude(const Item: _TItem_);
1356
1357 {** Excludes all the items of ASet. }
1358 procedure ExcludeAll(ASet: TGenHashSet);
1359
1360 {** Returns a cursor that designates the first element of the container or
1361 NilCursor if the container is empty. }
Firstnull1362 function First: THashSetCursor;
1363
GetEnumeratornull1364 function GetEnumerator : TEnumerator;
1365
GetItemAtnull1366 function GetItemAt(const Position: THashSetCursor): _TItem_;
1367
1368 {** Checks if Item is present in the container. If no match is found, inserts
1369 the item into the set.}
1370 procedure Include(const Item: _TItem_);
1371
1372 {** Includes all the items of ASet. }
1373 procedure IncludeAll(ASet: TGenHashSet);
1374
1375 {** Checks if Item is present in the container. If no match is found, inserts
1376 the item into the set. Otherwise, raises an exception. }
1377 procedure Insert(const Item: _TItem_);
1378
1379 {** Checks if Item is present in the container. If no match is found, inserts
1380 the item into the set and sets Inserted to true. Otherwise, sets Inserted
1381 to false. }
1382 procedure Insert(const Item: _TItem_; out Inserted: Boolean);
1383
1384 {** Clears Self and then adds to Self all the items of Left that are present
1385 in Right. }
1386 procedure Intersection(Left, Right: TGenHashSet);
1387
1388 {** Returns true if the container is empty. }
IsEmptynull1389 function IsEmpty: Boolean; inline;
1390
1391 {** Returns true if all the items in Self are present in OfSet. }
IsSubsetnull1392 function IsSubset(OfSet: TGenHashSet) : Boolean;
1393
1394 {** Returns true if at least one item of Self is present in ASet. }
Overlapsnull1395 function Overlaps(ASet: TGenHashSet) : Boolean;
1396
1397 procedure ReadItemAt(const Position: THashSetCursor; out Value: _TItem_);
1398
1399 {** Clears Self and then adds to Self all the items of Left that are not
1400 present in Right all the items of Right that are not present in Left. }
1401 procedure SymmetricDifference(Left, Right: TGenHashSet);
1402
1403 {** Return a string representation for the container. }
ToStringnull1404 function ToString : String; override;
1405
1406 {** Clears Self and then adds to Self all the items of Left and all the items
1407 of Right. }
1408 procedure Union(Left, Right: TGenHashSet);
1409
1410 {** Provides access to the items in the container. }
1411 property Items[const Position: THashSetCursor] : _TItem_ read GetItemAt;
1412 default;
1413
1414 {** A nil cursor. }
1415 property NilCursor: THashSetCursor read fNilCursor;
1416
1417 property OnItemsEqual : TItemEquals read GetOnItemsEqual write SetOnItemsEqual;
1418 property OnItemToString : TItemToString read GetItemToString write SetOnItemToString;
1419 property OnHashItem : THashItem read GetOnHashItem write SetOnHashItem;
1420
1421 property Size : Integer read GetSize;
1422 end;
1423
1424 TAbstractTreeMap = class;
1425
1426 { TTreeMapCursor }
1427
1428 TTreeMapCursor = object
1429 strict private
1430 fTreeMap : TAbstractTreeMap;
1431 fEntry : Pointer;
1432
1433 public
1434 {** Check if the cursors designate the same item. }
Equalsnull1435 function Equals(const Cursor: TTreeMapCursor) : Boolean; inline;
1436
1437 {** Check if the cursors designate an item. }
HasItemnull1438 function HasItem: Boolean; inline;
1439
1440 {** Constructor. }
1441 constructor Init(Map : TAbstractTreeMap; AnEntry: Pointer = nil);
1442
1443 {** Returns true if the cursor designates the first element. }
IsFirstnull1444 function IsFirst: Boolean; inline;
1445
1446 {** Returns true if the cursor designates the last element. }
IsLastnull1447 function IsLast: Boolean; inline;
1448
1449 {** Equivalent to (not HasItem). }
IsNilnull1450 function IsNil: Boolean; inline;
1451
1452 {** If cursor is nil then do nothing, else if cursor is last then cursor
1453 becomes nil cursor, otherwise move cursor to the next item. }
1454 procedure MoveNext; inline;
1455
1456 {** If cursor is nil then do nothing, else if cursor is first then cursor
1457 becomes nil cursor, otherwise move cursor to the previous item. }
1458 procedure MovePrevious; inline;
1459
1460 property TreeMap : TAbstractTreeMap read fTreeMap;
1461
1462 {** Designated entry. }
1463 property Entry : Pointer read fEntry write fEntry;
1464 end;
1465
1466 TAbstractTreeMap = class(TContainer)
1467 protected
CursorIsFirstnull1468 function CursorIsFirst(const Cursor: TTreeMapCursor) : Boolean; virtual; abstract;
CursorIsLastnull1469 function CursorIsLast(const Cursor: TTreeMapCursor) : Boolean; virtual; abstract;
1470 procedure CursorMoveNext(const Cursor: TTreeMapCursor); virtual; abstract;
1471 procedure CursorMovePrev(const Cursor: TTreeMapCursor); virtual; abstract;
1472 end;
1473
1474 { TGenTreeMap }
1475
1476 generic TGenTreeMap<_TKey_, _TItem_> = class(TAbstractTreeMap)
1477 public type
1478 TCompareKeys = function (const A, B: _TKey_) : Integer of object;
1479 TItemToString = function (const Item: _TItem_) : String of object;
1480 TKeyToString = function (const Key: _TKey_) : String of object;
1481 TEnumerator = specialize TGenEnumerator<_TItem_, TTreeMapCursor>;
1482
1483 PItem = ^_TItem_;
1484
1485 private type
1486 TColor = (cBlack, cRed);
1487
1488 PEntry = ^TEntry;
1489
1490 TEntry = record
1491 Color : TColor;
1492 Key : _TKey_;
1493 Left : PEntry;
1494 Parent : PEntry;
1495 Right : PEntry;
1496 Value : _TItem_;
1497 end;
1498 strict private
1499 fNilCursor : TTreeMapCursor;
1500 fOnCompareKeys: TCompareKeys;
1501 fOnItemToString: TItemToString;
1502 fOnKeyToString: TKeyToString;
1503 fSize : Integer;
1504 fRoot : PEntry;
1505
ColorOfnull1506 function ColorOf(E: PEntry) : TColor; inline;
1507 procedure DeleteEntry(E: PEntry);
1508 procedure DeleteTree(E: PEntry);
EnumeratorGetnull1509 function EnumeratorGet(const Pos: TTreeMapCursor) : _TItem_;
EnumeratorNextnull1510 function EnumeratorNext(var Pos: TTreeMapCursor) : Boolean;
1511 procedure RepairAfterDelete(E: PEntry);
1512 procedure RepairAfterInsert(E: PEntry);
GetCeilingEntrynull1513 function GetCeilingEntry(const Key: _TKey_) : PEntry;
GetEntrynull1514 function GetEntry(const Key: _TKey_) : PEntry;
GetFirstEntrynull1515 function GetFirstEntry : PEntry;
GetFloorEntrynull1516 function GetFloorEntry(const Key: _TKey_) : PEntry;
GetLastEntrynull1517 function GetLastEntry : PEntry;
LeftOfnull1518 function LeftOf(E: PEntry) : PEntry; inline;
NewEntrynull1519 function NewEntry(AParent: PEntry; const AKey: _TKey_;
1520 const AValue: _TItem_) : PEntry;
ParentOfnull1521 function ParentOf(E: PEntry) : PEntry; inline;
Predecessornull1522 function Predecessor(E: PEntry) : PEntry;
RightOfnull1523 function RightOf(E: PEntry) : PEntry; inline;
1524 procedure RotateLeft(E: PEntry);
1525 procedure RotateRight(E: PEntry);
1526 procedure SetColor(E: PEntry; Color: TColor);
1527 procedure SetOnCompareKeys(AValue: TCompareKeys);
1528 procedure SetOnItemToString(AValue: TItemToString);
1529 procedure SetOnKeyToString(AValue: TKeyToString);
Successornull1530 function Successor(E: PEntry) : PEntry;
1531
1532 protected
CursorIsFirstnull1533 function CursorIsFirst(const Cursor: TTreeMapCursor) : Boolean; override;
CursorIsLastnull1534 function CursorIsLast(const Cursor: TTreeMapCursor) : Boolean; override;
1535 procedure CursorMoveNext(const Cursor: TTreeMapCursor); override;
1536 procedure CursorMovePrev(const Cursor: TTreeMapCursor); override;
1537
1538 public
1539 {** Searches for the first entry whose key is not less than Key. If such an
1540 entry is found, a cursor that designates it is returned. Otherwise
1541 NilCursor is returned. }
Ceilingnull1542 function Ceiling(const Key: _TKey_) : TTreeMapCursor;
1543
1544 {** Removes all the items from the container. }
1545 procedure Clear;
1546
1547 {** Returns true if the container contains Key. }
Containsnull1548 function Contains(const Key : _TKey_) : Boolean;
1549
1550 {** Creates an empty tree map. }
1551 constructor Create;
1552
DefaultCompareKeysnull1553 function DefaultCompareKeys(const A, B: _TKey_) : Integer; virtual;
DefaultItemToStringnull1554 function DefaultItemToString(const Item: _TItem_) : String; virtual;
DefaultKeyToStringnull1555 function DefaultKeyToString(const Key: _TKey_) : String; virtual;
1556
1557 {** Checks if an item with the key to Key is present. If a match is found,
1558 removes the item from the map. Otherwise raise an exception. }
1559 procedure Delete(const Key: _TKey_);
1560
1561 {** Deletes the item designated by Position. }
1562 procedure DeleteAt(const Position: TTreeMapCursor);
1563
1564 {** Deletes the first item. }
1565 procedure DeleteFirst;
1566
1567 {** Deletes the last item. }
1568 procedure DeleteLast;
1569
1570 {** Destroys the container. }
1571 destructor Destroy; override;
1572
1573 {** Checks if an item with the key Key is present. If a match is found,
1574 removes the item from the map. }
1575 procedure Exclude(const Key : _TKey_);
1576
1577 {** Checks if an item associated with Key is present. If a match is found, a
1578 cursor designating the matching item is returned. Otherwise, NilCursor
1579 is returned. }
Findnull1580 function Find(const Key : _TKey_) : TTreeMapCursor;
1581
1582 {** Returns a cursor that designates the first element of the container or
1583 NilCursor if the container is empty. }
Firstnull1584 function First: TTreeMapCursor;
1585
1586 {** Returns the first Item. }
FirstItemnull1587 function FirstItem: _TItem_;
1588
1589 {** If the map is empty raises an exception. Otherwise, returns the smallest
1590 Key. }
FirstKeynull1591 function FirstKey: _TKey_;
1592
1593 {** Searches for the last entry whose key is not greater than Key. If such
1594 an entry is found, a cursor that designates it is returned. Otherwise
1595 NilCursor is returned. }
Floornull1596 function Floor(const Key: _TKey_) : TTreeMapCursor;
1597
GetEnumeratornull1598 function GetEnumerator : TEnumerator;
1599
GetItemnull1600 function GetItem(const Key: _TKey_): _TItem_;
1601
GetItemAtnull1602 function GetItemAt(const Position: TTreeMapCursor): _TItem_;
1603
GetKeyAtnull1604 function GetKeyAt(const Position : TTreeMapCursor) : _TKey_;
1605
1606 {** Inserts Key and Value into the map. If an entry with the same Key is
1607 already in the map, then the old value is replaced. }
1608 procedure Include(const Key : _TKey_; const Value: _TItem_);
1609
1610 {** Inserts Key and Value into the map. If an entry with the same Key is
1611 already in the map, then an exception is raised. }
1612 procedure Insert(const Key : _TKey_; const Value: _TItem_);
1613
1614 {** If an entry with the same Key is already in the map, then Inserted is
1615 set to false. Otherwise, Insert inserts Key and Value into the map and
1616 sets Inserted to true. }
1617 procedure Insert(const Key : _TKey_; const Value: _TItem_;
1618 out Inserted: Boolean);
1619
1620 {** Returns true if the container is empty. }
IsEmptynull1621 function IsEmpty: Boolean; inline;
1622
1623 {** Returns a cursor that designates the last element of the container or
1624 NilCursor if the container is empty. }
Lastnull1625 function Last: TTreeMapCursor;
1626
1627 {** Returns the last Item. }
LastItemnull1628 function LastItem: _TItem_;
1629
1630 {** If the map is empty raises an exception. Otherwise, returns the greatest
1631 Key. }
LastKeynull1632 function LastKey: _TKey_;
1633
1634 procedure ReadFirstItem(out Value : _TItem_); inline;
1635
1636 procedure ReadFirstKey(out Key : _TKey_); inline;
1637
1638 procedure ReadItem(const Key: _TKey_; out Value: _TItem_);
1639
1640 procedure ReadItemAt(const Position: TTreeMapCursor; out Value: _TItem_);
1641
1642 procedure ReadKeyAt(const Position : TTreeMapCursor; out Key: _TKey_);
1643
1644 procedure ReadLastItem(out Value : _TItem_); inline;
1645
1646 procedure ReadLastKey(out Key : _TKey_); inline;
1647
1648 {** Checks if an entry with the key Key is present. If a match is found,
1649 assigns Key and Value to the matching entry. Otherwise, an exception is
1650 raised. }
1651 procedure Replace(const Key : _TKey_; const Value: _TItem_);
1652
1653 procedure SetItemAt(const Position: TTreeMapCursor; Value: _TItem_);
1654
1655 {** Return a string representation for the container. }
ToStringnull1656 function ToString : String; override;
1657
1658 {** Provides access to the items in the container. }
1659 property ItemAt[const Position: TTreeMapCursor] : _TItem_ read GetItemAt
1660 write SetItemAt;
1661
1662 {** Provides access to the items in the container. }
1663 property Items[const Key: _TKey_] : _TItem_ read GetItem write Include;
1664 default;
1665
1666 {** Provides access to the keys in the container. }
1667 property Keys[const Position: TTreeMapCursor] : _TKey_ read GetKeyAt;
1668
1669 {** A nil cursor. }
1670 property NilCursor: TTreeMapCursor read fNilCursor;
1671
1672 property OnCompareKeys : TCompareKeys read fOnCompareKeys write SetOnCompareKeys;
1673 property OnItemToString : TItemToString read fOnItemToString write SetOnItemToString;
1674 property OnKeyToString : TKeyToString read fOnKeyToString write SetOnKeyToString;
1675
1676 {** Number of items. }
1677 property Size : Integer read fSize;
1678 end;
1679
1680 TAbstractTreeSet = class(TContainer)
1681 end;
1682
1683 TTreeSetCursor = object
1684 strict private
1685 fTreeSet : TAbstractTreeSet;
1686 fPos : TTreeMapCursor;
1687
1688 public
1689 {** Check if the cursors designate the same item. }
Equalsnull1690 function Equals(const Cursor: TTreeSetCursor) : Boolean;
1691
1692 {** Check if the cursors designate an item. }
HasItemnull1693 function HasItem: Boolean; inline;
1694
1695 {** Constructor. }
1696 constructor Init(TreeSet : TAbstractTreeSet; const APos: TTreeMapCursor);
1697
1698 {** Returns true if the cursor designates the first element. }
IsFirstnull1699 function IsFirst: Boolean; inline;
1700
1701 {** Returns true if the cursor designates the last element. }
IsLastnull1702 function IsLast: Boolean; inline;
1703
1704 {** Equivalent to (not HasItem). }
IsNilnull1705 function IsNil: Boolean; inline;
1706
1707 {** If cursor is nil then do nothing, else if cursor is last then cursor
1708 becomes nil cursor, otherwise move cursor to the next item. }
1709 procedure MoveNext;
1710
1711 {** If cursor is nil then do nothing, else if cursor is first then cursor
1712 becomes nil cursor, otherwise move cursor to the previous item. }
1713 procedure MovePrevious;
1714
1715 property TreeSet : TAbstractTreeSet read fTreeSet;
1716
1717 {** Designated entry. }
1718 property Pos : TTreeMapCursor read fPos;
1719 end;
1720
1721 { TGenTreeSet }
1722
1723 generic TGenTreeSet<_TItem_> = class(TAbstractTreeSet)
1724 public type
1725 TCompareItems = function (const A, B: _TItem_) : Integer of object;
1726 TItemToString = function (const Item: _TItem_) : String of object;
1727 TEnumerator = specialize TGenEnumerator<_TItem_, TTreeSetCursor>;
1728
1729 private type
1730 TMap = specialize TGenTreeMap<_TItem_, Integer>;
1731
1732 private
1733 fMap : TMap;
1734 fNilCursor : TTreeSetCursor;
1735
EnumeratorGetnull1736 function EnumeratorGet(const Pos: TTreeSetCursor) : _TItem_;
EnumeratorNextnull1737 function EnumeratorNext(var Pos: TTreeSetCursor) : Boolean;
1738 procedure ExchangeContent(ASet: TGenTreeSet);
GetOnCompareItemsnull1739 function GetOnCompareItems: TCompareItems;
GetOnItemToStringnull1740 function GetOnItemToString: TItemToString;
GetSizenull1741 function GetSize: Integer; inline;
1742 procedure SetOnCompareItems(AValue: TCompareItems);
1743 procedure SetOnItemToString(AValue: TItemToString);
1744
1745 public
1746 {** Searches for the first item which is not less than Item. If such an item
1747 is found, a cursor that designates it is returned. Otherwise NilCursor is
1748 returned. }
Ceilingnull1749 function Ceiling(const Item: _TItem_) : TTreeSetCursor;
1750
1751 {** Removes all the items from the container. }
1752 procedure Clear;
1753
1754 {** Returns true if the container contains Item. }
Containsnull1755 function Contains(const Item: _TItem_) : Boolean;
1756
1757 {** Creates an empty tree set. }
1758 constructor Create;
1759
DefaultCompareItemsnull1760 function DefaultCompareItems(const A, B: _TItem_) : Integer; virtual;
DefaultItemToStringnull1761 function DefaultItemToString(const Item: _TItem_) : String; virtual;
1762
1763 {** Checks if Item is present in the container. If a match is found, removes
1764 the element from the set. Otherwise, raises an exception. }
1765 procedure Delete(const Item: _TItem_);
1766
1767 {** Deletes the item designated by Position. }
1768 procedure DeleteAt(const Position: TTreeSetCursor);
1769
1770 {** Deletes the first item. }
1771 procedure DeleteFirst;
1772
1773 {** Deletes the last item. }
1774 procedure DeleteLast;
1775
1776 destructor Destroy; override;
1777
1778 {** Clears Self and then adds to Self all the items of Left that are not
1779 present in Right. }
1780 procedure Difference(Left, Right: TGenTreeSet);
1781
1782 {** Checks if Item is present in the container. If a match is found, removes
1783 the item from the set. }
1784 procedure Exclude(const Item: _TItem_);
1785
1786 {** Excludes all the items of ASet. }
1787 procedure ExcludeAll(ASet: TGenTreeSet);
1788
1789 {** Returns a cursor that designates the first element of the container or
1790 NilCursor if the container is empty. }
Firstnull1791 function First: TTreeSetCursor;
1792
1793 {** Returns the first Item. }
FirstItemnull1794 function FirstItem: _TItem_;
1795
1796 {** Searches for the last item which is not greater than Item. If such an
1797 item is found, a cursor that designates it is returned. Otherwise
1798 NilCursor is returned. }
Floornull1799 function Floor(const Item: _TItem_) : TTreeSetCursor;
1800
GetEnumeratornull1801 function GetEnumerator : TEnumerator;
1802
GetItemAtnull1803 function GetItemAt(const Position: TTreeSetCursor): _TItem_;
1804
1805 {** Checks if Item is present in the container. If no match is found, inserts
1806 the item into the set.}
1807 procedure Include(const Item: _TItem_);
1808
1809 {** Includes all the items of ASet. }
1810 procedure IncludeAll(ASet: TGenTreeSet);
1811
1812 {** Checks if Item is present in the container. If no match is found, inserts
1813 the item into the set. Otherwise, raises an exception. }
1814 procedure Insert(const Item: _TItem_);
1815
1816 {** Checks if Item is present in the container. If no match is found, inserts
1817 the item into the set and sets Inserted to true. Otherwise, sets Inserted
1818 to false. }
1819 procedure Insert(const Item: _TItem_; out Inserted: Boolean);
1820
1821 {** Clears Self and then adds to Self all the items of Left that are present
1822 in Right. }
1823 procedure Intersection(Left, Right: TGenTreeSet);
1824
1825 {** Returns true if the set is empty. }
IsEmptynull1826 function IsEmpty: Boolean; inline;
1827
1828 {** Returns true if all the items in Self are present in OfSet. }
IsSubsetnull1829 function IsSubset(OfSet: TGenTreeSet) : Boolean;
1830
1831 {** Returns a cursor that designates the last element of the container
1832 or NilCursor if the container is empty. }
Lastnull1833 function Last: TTreeSetCursor;
1834
1835 {** Returns the last Item. }
LastItemnull1836 function LastItem: _TItem_;
1837
1838 {** Returns true if at least one item of Self is present in ASet. }
Overlapsnull1839 function Overlaps(ASet: TGenTreeSet) : Boolean;
1840
1841 procedure ReadFirstItem(out Value : _TItem_); inline;
1842
1843 procedure ReadItemAt(const Position: TTreeSetCursor; out Value: _TItem_);
1844
1845 procedure ReadLastItem(out Value : _TItem_); inline;
1846
1847 {** Clears Self and then adds to Self all the items of Left that are not
1848 present in Right all the items of Right that are not present in Left. }
1849 procedure SymmetricDifference(Left, Right: TGenTreeSet);
1850
1851 {** Return a string representation for the container. }
ToStringnull1852 function ToString : String; override;
1853
1854 {** Clears Self and then adds to Self all the items of Left and all the
1855 items of Right. }
1856 procedure Union(Left, Right: TGenTreeSet);
1857
1858 {** Provides access to the items in the container. }
1859 property Items[const Position: TTreeSetCursor] : _TItem_ read GetItemAt; default;
1860
1861 {** A nil cursor. }
1862 property NilCursor: TTreeSetCursor read fNilCursor;
1863
1864 property OnCompareItems : TCompareItems read GetOnCompareItems write SetOnCompareItems;
1865
1866 property OnItemToString : TItemToString read GetOnItemToString write SetOnItemToString;
1867
1868 {** Number of items. }
1869 property Size : Integer read GetSize;
1870 end;
1871
1872
1873 { TBitSet }
1874
1875 {** Class to store collections of bits. }
1876
1877 TBitSet = class(TContainer)
1878 private
1879 fBits : array of Byte;
1880 fExtraMask : Byte;
1881 fLen : Integer;
1882 fSize : Integer;
1883
1884 procedure ClearExtraBits;
1885 public
1886 {** Performs a logical AND on the bits in the bitset with the bits of
1887 BitSet. }
1888 procedure AndBits(BitSet : TBitSet);
1889
1890 {** Returns @true if all the bits of the bitset are set, and @false
1891 otherwise. }
Allnull1892 function All : Boolean;
1893
1894 {** Returns @true if any of the bits in the bitset is set, and @false
1895 otherwise. }
Anynull1896 function Any : Boolean;
1897
1898 {** Returns the number of bits in the bitset that are set. }
Cardinalitynull1899 function Cardinality : Integer;
1900
1901 {** Sets to @false the bit at position Index.}
1902 procedure Clear(Index: Integer);
1903
1904 {** Sets to @false all bits in the bitset.}
1905 procedure ClearAll;
1906
1907 constructor Create(Size: Integer);
1908
1909 constructor Create(Size: Integer; Value: QWord);
1910
1911 constructor Create(Size: Integer; const Value: String);
1912
1913 constructor Create(Value: TBitSet);
1914
1915 constructor Create(Size: Integer; Value: TBitSet);
1916
1917 procedure Debug;
1918
1919 {** Returns @true only if the bitset and Value are of the same size and have
1920 exactly the same set of bits set to @true.}
Equalsnull1921 function Equals(Obj: TObject) : Boolean; override;
1922
1923 {** Flips the bit at position Index. }
1924 procedure Flip(Index: Integer);
1925
1926 {** Flips all bits in the bitset. }
1927 procedure FlipAll;
1928
1929 procedure FlipFast(Index: Integer); inline;
1930
1931 procedure Initialize(Value: Int64);
1932
1933 procedure Initialize(const Value : String);
1934
1935 procedure Initialize(Value : TBitSet);
1936
1937 {** Returns @true if none of the bits in the bitset is set to @true, and
1938 @false otherwise.}
Nonenull1939 function None : Boolean;
1940
1941 procedure NotBits(BitSet : TBitSet);
1942
1943 {** Performs a logical OR on the bits in the bitset with the bits of
1944 BitSet. }
1945 procedure OrBits(BitSet : TBitSet);
1946
1947 {** Sets to @true all bits in the bitset.}
1948 procedure SetAll;
1949
1950 {** Sets to Value the bit at position Index.}
1951 procedure SetBit(Index : Integer; Value: Boolean);
1952
1953 procedure SetBitFast(Index : Integer; Value: Boolean); inline;
1954
1955 {** Sets to @true the bit at position Index.}
1956 procedure SetOn(Index: Integer);
1957
1958 procedure ShiftLeft(Count : Integer = 1);
1959
1960 procedure ShiftRight(Count : Integer = 1);
1961
1962 {** Returns @true if the bit at position Index is set, and @false
1963 otherwise.}
Testnull1964 function Test(Index: Integer) : Boolean;
1965
TestFastnull1966 function TestFast(Index : Integer): Boolean; inline;
1967
ToIntegernull1968 function ToInteger: Integer;
1969
ToInt64null1970 function ToInt64: Int64;
1971
ToQWordnull1972 function ToQWord: QWord;
1973
ToStringnull1974 function ToString: String; override;
1975
1976 {** Performs a logical XOR on the bits in the bitset with the bits of
1977 BitSet. }
1978 procedure XorBits(BitSet : TBitSet);
1979
1980 property Bits[Index : Integer] : Boolean read TestFast
1981 write SetBitFast; default;
1982
1983 property Size : Integer read fSize;
1984 end;
1985
HashDatanull1986 function HashData(Data : PByte; DataSize: Integer) : Integer;
HashStringnull1987 function HashString(const Str: String) : Integer;
1988
1989 implementation
1990
1991 uses Math;
1992
1993 const
1994 S_BitSetsAreIncompatible = 'bit sets are incompatible';
1995 S_ContainerEmpty = 'container is empty';
1996 S_CursorIsNil = 'cursor is nil';
1997 S_CursorDenotesWrongContainer = 'cursor denotes wrong container';
1998 S_IndexOutOfRange = 'index out of range';
1999 S_InvalidBitSetSize = 'invalid bit set size';
2000 S_InvalidBinaryValue = 'invalid binary value';
2001 S_ItemNotInSet = 'item not in set';
2002 S_ItemAlreadyInSet = 'item already in set';
2003 S_KeyNotInMap = 'key not in map';
2004 S_KeyAlreadyInMap = 'key already in map';
2005 S_MethodNotRedefined = 'method not redefined';
2006
2007 SBox : array [Byte] of LongWord = ( $F53E1837, $5F14C86B, $9EE3964C,
2008 $FA796D53, $32223FC3, $4D82BC98, $A0C7FA62, $63E2C982, $24994A5B, $1ECE7BEE,
2009 $292B38EF, $D5CD4E56, $514F4303, $7BE12B83, $7192F195, $82DC7300, $084380B4,
2010 $480B55D3, $5F430471, $13F75991, $3F9CF22C, $2FE0907A, $FD8E1E69, $7B1D5DE8,
2011 $D575A85C, $AD01C50A, $7EE00737, $3CE981E8, $0E447EFA, $23089DD6, $B59F149F,
2012 $13600EC7, $E802C8E6, $670921E4, $7207EFF0, $E74761B0, $69035234, $BFA40F19,
2013 $F63651A0, $29E64C26, $1F98CCA7, $D957007E, $E71DDC75, $3E729595, $7580B7CC,
2014 $D7FAF60B, $92484323, $A44113EB, $E4CBDE08, $346827C9, $3CF32AFA, $0B29BCF1,
2015 $6E29F7DF, $B01E71CB, $3BFBC0D1, $62EDC5B8, $B7DE789A, $A4748EC9, $E17A4C4F,
2016 $67E5BD03, $F3B33D1A, $97D8D3E9, $09121BC0, $347B2D2C, $79A1913C, $504172DE,
2017 $7F1F8483, $13AC3CF6, $7A2094DB, $C778FA12, $ADF7469F, $21786B7B, $71A445D0,
2018 $A8896C1B, $656F62FB, $83A059B3, $972DFE6E, $4122000C, $97D9DA19, $17D5947B,
2019 $B1AFFD0C, $6EF83B97, $AF7F780B, $4613138A, $7C3E73A6, $CF15E03D, $41576322,
2020 $672DF292, $B658588D, $33EBEFA9, $938CBF06, $06B67381, $07F192C6, $2BDA5855,
2021 $348EE0E8, $19DBB6E3, $3222184B, $B69D5DBA, $7E760B88, $AF4D8154, $007A51AD,
2022 $35112500, $C9CD2D7D, $4F4FB761, $694772E3, $694C8351, $4A7E3AF5, $67D65CE1,
2023 $9287DE92, $2518DB3C, $8CB4EC06, $D154D38F, $E19A26BB, $295EE439, $C50A1104,
2024 $2153C6A7, $82366656, $0713BC2F, $6462215A, $21D9BFCE, $BA8EACE6, $AE2DF4C1,
2025 $2A8D5E80, $3F7E52D1, $29359399, $FEA1D19C, $18879313, $455AFA81, $FADFE838,
2026 $62609838, $D1028839, $0736E92F, $3BCA22A3, $1485B08A, $2DA7900B, $852C156D,
2027 $E8F24803, $00078472, $13F0D332, $2ACFD0CF, $5F747F5C, $87BB1E2F, $A7EFCB63,
2028 $23F432F0, $E6CE7C5C, $1F954EF6, $B609C91B, $3B4571BF, $EED17DC0, $E556CDA0,
2029 $A7846A8D, $FF105F94, $52B7CCDE, $0E33E801, $664455EA, $F2C70414, $73E7B486,
2030 $8F830661, $8B59E826, $BB8AEDCA, $F3D70AB9, $D739F2B9, $4A04C34A, $88D0F089,
2031 $E02191A2, $D89D9C78, $192C2749, $FC43A78F, $0AAC88CB, $9438D42D, $9E280F7A,
2032 $36063802, $38E8D018, $1C42A9CB, $92AAFF6C, $A24820C5, $007F077F, $CE5BC543,
2033 $69668D58, $10D6FF74, $BE00F621, $21300BBE, $2E9E8F46, $5ACEA629, $FA1F86C7,
2034 $52F206B8, $3EDF1A75, $6DA8D843, $CF719928, $73E3891F, $B4B95DD6, $B2A42D27,
2035 $EDA20BBF, $1A58DBDF, $A449AD03, $6DDEF22B, $900531E6, $3D3BFF35, $5B24ABA2,
2036 $472B3E4C, $387F2D75, $4D8DBA36, $71CB5641, $E3473F3F, $F6CD4B7F, $BF7D1428,
2037 $344B64D0, $C5CDFCB6, $FE2E0182, $2C37A673, $DE4EB7A3, $63FDC933, $01DC4063,
2038 $611F3571, $D167BFAF, $4496596F, $3DEE0689, $D8704910, $7052A114, $068C9EC5,
2039 $75D0E766, $4D54CC20, $B44ECDE2, $4ABC653E, $2C550A21, $1A52C0DB, $CFED03D0,
2040 $119BAFE2, $876A6133, $BC232088, $435BA1B2, $AE99BBFA, $BB4F08E4, $A62B5F49,
2041 $1DA4B695, $336B84DE, $DC813D31, $00C134FB, $397A98E6, $151F0E64, $D9EB3E69,
2042 $D3C7DF60, $D2F2C336, $2DDD067B, $BD122835, $B0B3BD3A, $B0D54E46, $8641F1E4,
2043 $A0B38F96, $51D39199, $37A6AD75, $DF84EE41, $3C034CBA, $ACDA62FC, $11923B8B,
2044 $45EF170A);
2045
2046 Card : array [Byte] of Byte = (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
2047 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, 2,
2048 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2,
2049 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4,
2050 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5,
2051 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3,
2052 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4,
2053 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6,
2054 7, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6,
2055 4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4,
2056 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
2057
2058 {--- HashData ---}
2059 {$PUSH}
2060 {$O-}{$R-}{$Q-}
HashDatanull2061 function HashData(Data : PByte; DataSize: Integer) : Integer;
2062 var
2063 I : Integer;
2064 begin
2065 Result := 0;
2066 for I := 1 to DataSize do
2067 begin
2068 Result := Result xor Integer(SBox[Data^]);
2069 Result := Result * 3;
2070 Inc(Data);
2071 end;
2072 end;
2073 {$POP}
2074
2075 {--- HashString ---}
HashStringnull2076 function HashString(const Str: String): Integer;
2077 begin
2078 if Str = '' then
2079 Result := 0
2080 else
2081 Result := HashData(@Str[1], Length(Str));
2082 end;
2083
2084 {===============}
2085 {=== TBitSet ===}
2086 {===============}
2087
2088 {$push}
2089 {$rangechecks off}
2090 {$overflowchecks off}
2091
2092 {--- TBitSet.ClearExtraBits ---}
2093 procedure TBitSet.ClearExtraBits;
2094 begin
2095 if fExtraMask <> High(Byte) then
2096 fBits[fLen - 1] := fBits[fLen - 1] and fExtraMask;
2097 end;
2098
2099 {--- TBitSet.AndBits ---}
2100 procedure TBitSet.AndBits(BitSet: TBitSet);
2101 var
2102 I: Integer;
2103 begin
2104 if BitSet.fSize <> fSize then
2105 RaiseError(S_BitSetsAreIncompatible);
2106
2107 for I := 0 to fLen - 1 do
2108 fBits[I] := fBits[I] and BitSet.fBits[I];
2109
2110 ClearExtraBits;
2111 end;
2112
2113 {--- TBitSet.All ---}
Allnull2114 function TBitSet.All: Boolean;
2115 var
2116 I: Integer;
2117 begin
2118 for I := 0 to fLen - 2 do
2119 if fBits[I] <> High(Byte) then
2120 begin
2121 Result := false;
2122 Exit;
2123 end;
2124
2125 Result := (fBits[fLen - 1] = fExtraMask);
2126 end;
2127
2128 {--- TBitSet.Any ---}
Anynull2129 function TBitSet.Any: Boolean;
2130 var
2131 I: Integer;
2132 begin
2133 Result := false;
2134 for I := 0 to fLen - 1 do
2135 if fBits[I] <> 0 then
2136 begin
2137 Result := true;
2138 Break;
2139 end;
2140 end;
2141
2142 {--- TBitSet.Cardinality ---}
Cardinalitynull2143 function TBitSet.Cardinality: Integer;
2144 var
2145 I : Integer;
2146 begin
2147 Result := 0;
2148
2149 for I := 0 to fLen - 2 do
2150 Result := Result + Card[fBits[I]];
2151 Result := Result + Card[(fBits[fLen - 1] and fExtraMask)];
2152 end;
2153
2154 {--- TBitSet.Clear ---}
2155 procedure TBitSet.Clear(Index: Integer);
2156 begin
2157 if (Index < 0) or (Index >= fSize) then
2158 RaiseIndexOutOfRange;
2159 SetBitFast(Index, false);
2160 end;
2161
2162 {--- TBitSet.ClearAll ---}
2163 procedure TBitSet.ClearAll;
2164 var
2165 I: Integer;
2166 begin
2167 for I := Low(fBits) to High(fBits) do
2168 fBits[I] := 0;
2169 end;
2170
2171 {--- TBitSet.Create ---}
2172 constructor TBitSet.Create(Size: Integer);
2173 var
2174 ArraySize, I : Integer;
2175 begin
2176 if Size <= 0 then
2177 RaiseError(S_InvalidBitSetSize);
2178
2179 fSize := Size;
2180 fLen := (fSize + (SizeOf(Byte) * 8) - 1) div (SizeOf(Byte) * 8);
2181
2182 SetLength(fBits, fLen);
2183
2184 ArraySize := fLen * SizeOf(Byte) * 8;
2185 if ArraySize = Size then
2186 fExtraMask := High(Byte)
2187 else
2188 begin
2189 fExtraMask := 1;
2190 for I := 2 to SizeOf(Byte) * 8 - (ArraySize - Size) do
2191 fExtraMask := (fExtraMask shl 1) or 1;
2192 end;
2193 end;
2194
2195 {--- TBitSet.Create ---}
2196 constructor TBitSet.Create(Size: Integer; Value: QWord);
2197 begin
2198 Create(Size);
2199 Initialize(Value);
2200 end;
2201
2202 {--- TBitSet.Create ---}
2203 constructor TBitSet.Create(Size: Integer; const Value: String);
2204 begin
2205 Create(Size);
2206 Initialize(Value);
2207 end;
2208
2209 {--- TBitSet.Create ---}
2210 constructor TBitSet.Create(Value: TBitSet);
2211 begin
2212 Create(Value.fSize, Value);
2213 end;
2214
2215 {--- TBitSet.Create ---}
2216 constructor TBitSet.Create(Size: Integer; Value: TBitSet);
2217 var
2218 I, IMax: Integer;
2219 begin
2220 Create(Size);
2221
2222 IMax := Min(Size - 1, Value.fSize - 1);
2223 for I := 0 to IMax do
2224 if Value.TestFast(I) then
2225 SetBitFast(I, true);
2226 end;
2227
2228 {--- TBitSet.Debug ---}
2229 procedure TBitSet.Debug;
2230 var
2231 I: Integer;
2232 begin
2233 Write('TBitSet@', HexStr(Self), ' : fLen=', fLen, ' fSize=', fSize);
2234 WriteLn(' fExtraMask=', BinStr(fExtraMask, SizeOf(fExtraMask) * 8));
2235 Write('fBits=[');
2236 for I := Low(fBits) to High(fBits) do
2237 Write(fBits[I], ' ');
2238 WriteLn(']');
2239 end;
2240
2241 {--- TBitSet.Equals ---}
Equalsnull2242 function TBitSet.Equals(Obj: TObject): Boolean;
2243 var
2244 I: Integer;
2245 Value : TBitSet;
2246 begin
2247 if Obj is TBitSet then
2248 begin
2249 Value := Obj as TBitSet;
2250 if fSize <> Value.fSize then
2251 RaiseError(S_BitSetsAreIncompatible);
2252
2253 Result := true;
2254 for I := Low(fBits) to High(fBits) do
2255 if fBits[I] <> Value.fBits[I] then
2256 begin
2257 Result := false;
2258 Exit;
2259 end;
2260 end
2261 else
2262 Result := false;
2263 end;
2264
2265 {--- TBitSet.Flip ---}
2266 procedure TBitSet.Flip(Index: Integer);
2267 var
2268 Rank, NBit : Integer;
2269 begin
2270 if (Index < 0) or (Index >= fSize) then
2271 RaiseIndexOutOfRange;
2272
2273 Rank := Index div (SizeOf(Byte) * 8);
2274 NBit := Index mod (SizeOf(Byte) * 8);
2275
2276 fBits[Rank] := fBits[Rank] xor (Byte(1) shl NBit);
2277 end;
2278
2279 {--- TBitSet.FlipAll ---}
2280 procedure TBitSet.FlipAll;
2281 var
2282 I: Integer;
2283 begin
2284 for I := Low(fBits) to High(fBits) do
2285 fBits[I] := not fBits[I];
2286 ClearExtraBits;
2287 end;
2288
2289 {--- TBitSet.FlipFast ---}
2290 procedure TBitSet.FlipFast(Index: Integer);
2291 var
2292 Rank, NBit : Integer;
2293 begin
2294 Rank := Index div (SizeOf(Byte) * 8);
2295 NBit := Index mod (SizeOf(Byte) * 8);
2296
2297 fBits[Rank] := fBits[Rank] xor (Byte(1) shl NBit);
2298 end;
2299
2300 {--- TBitSet.Initialize ---}
2301 procedure TBitSet.Initialize(Value: Int64);
2302 const
2303 NBits = SizeOf(Int64) * 8;
2304 var
2305 I, IMax: Integer;
2306 begin
2307 ClearAll;
2308
2309 IMax := Min(NBits - 1, fSize - 1);
2310 for I := 0 to IMax do
2311 begin
2312 if (Value and 1) <> 0 then
2313 SetBitFast(I, true);
2314 Value := Value shr 1;
2315 end;
2316 end;
2317
2318 {--- TBitSet.Initialize ---}
2319 procedure TBitSet.Initialize(const Value: String);
2320 var
2321 I, IMax, Len: Integer;
2322 begin
2323 ClearAll;
2324
2325 Len := Length(Value);
2326 IMax := Min(Len, fSize);
2327 for I := 1 to IMax do
2328 begin
2329 if Value[I] = '1' then
2330 SetBitFast(IMax - I, true)
2331 else if Value[I] <> '0' then
2332 RaiseError(S_InvalidBinaryValue);
2333 end;
2334 end;
2335
2336 {--- TBitSet.Initialize ---}
2337 procedure TBitSet.Initialize(Value: TBitSet);
2338 var
2339 I, IMax : Integer;
2340 begin
2341 ClearAll;
2342 IMax := Min(fSize - 1, Value.fSize - 1);
2343 for I := 0 to IMax do
2344 SetBitFast(I, Value.TestFast(I));
2345 end;
2346
2347 {--- TBitSet.None ---}
TBitSet.Nonenull2348 function TBitSet.None: Boolean;
2349 begin
2350 Result := not Any;
2351 end;
2352
2353 {--- TBitSet.NotBits ---}
2354 procedure TBitSet.NotBits(BitSet: TBitSet);
2355 var
2356 I: Integer;
2357 B : Integer;
2358 begin
2359 if BitSet.fSize <> fSize then
2360 RaiseError(S_BitSetsAreIncompatible);
2361
2362 for I := 0 to fLen - 1 do
2363 begin
2364 B := fBits[I];
2365 fBits[I] := B and (B xor BitSet.fBits[I]);
2366 end;
2367
2368 ClearExtraBits;
2369 end;
2370
2371 {--- TBitSet.OrBits ---}
2372 procedure TBitSet.OrBits(BitSet: TBitSet);
2373 var
2374 I: Integer;
2375 begin
2376 if BitSet.fSize <> fSize then
2377 RaiseError(S_BitSetsAreIncompatible);
2378
2379 for I := 0 to fLen - 1 do
2380 fBits[I] := fBits[I] or BitSet.fBits[I];
2381
2382 ClearExtraBits;
2383 end;
2384
2385 {--- TBitSet.SetAll ---}
2386 procedure TBitSet.SetAll;
2387 var
2388 I: Integer;
2389 begin
2390 for I := Low(fBits) to High(fBits) do
2391 fBits[I] := High(Byte);
2392 ClearExtraBits;
2393 end;
2394
2395 {--- TBitSet.SetBit ---}
2396 procedure TBitSet.SetBit(Index: Integer; Value: Boolean);
2397 begin
2398 if (Index < 0) or (Index >= fSize) then
2399 RaiseIndexOutOfRange;
2400 SetBitFast(Index, Value);
2401 end;
2402
2403 {--- TBitSet.SetBitFast ---}
2404 procedure TBitSet.SetBitFast(Index : Integer; Value: Boolean);
2405 var
2406 Rank, NBit : Integer;
2407 Mask : Byte;
2408 begin
2409 Rank := Index div (SizeOf(Byte) * 8);
2410 NBit := Index mod (SizeOf(Byte) * 8);
2411
2412 Mask := 1 shl NBit;
2413
2414 if Value then
2415 fBits[Rank] := fBits[Rank] or Mask
2416 else
2417 begin
2418 Mask := not Mask;
2419 fBits[Rank] := fBits[Rank] and Mask;
2420 end;
2421
2422 end;
2423
2424 {--- TBitSet.SetOn ---}
2425 procedure TBitSet.SetOn(Index: Integer);
2426 begin
2427 if (Index < 0) or (Index >= fSize) then
2428 RaiseIndexOutOfRange;
2429 SetBitFast(Index, true);
2430 end;
2431
2432 {--- TBitSet.ShiftLeft ---}
2433 procedure TBitSet.ShiftLeft(Count: Integer);
2434 var
2435 I: Integer;
2436 begin
2437 if Count = 0 then
2438 Exit
2439 else if Count < 0 then
2440 ShiftRight(- Count)
2441 else if Count >= fSize then
2442 ClearAll
2443 else if Count mod 8 = 0 then
2444 begin
2445 Count := Count div 8;
2446
2447 for I := fLen - Count - 1 downto 0 do
2448 fBits[I + Count] := fBits[I];
2449
2450 for I := 0 to Count - 1 do
2451 fBits[I] := 0;
2452
2453 ClearExtraBits;
2454 end
2455 else
2456 begin
2457 for I := fSize - Count - 1 downto 0 do
2458 SetBitFast(I + Count, TestFast(I));
2459
2460 for I := 0 to Count - 1 do
2461 SetBitFast(I, false);
2462 end;
2463 end;
2464
2465 {--- TBitSet.ShiftRight ---}
2466 procedure TBitSet.ShiftRight(Count: Integer);
2467 var
2468 I : Integer;
2469 begin
2470 if Count = 0 then
2471 Exit
2472 else if Count < 0 then
2473 ShiftLeft(- Count)
2474 else if Count >= fSize then
2475 ClearAll
2476 else if Count mod 8 = 0 then
2477 begin
2478 Count := Count div 8;
2479
2480 for I := Count to fLen - 1 do
2481 fBits[I - Count] := fBits[I];
2482
2483 for I := fLen - 1 downto fLen - Count do
2484 fBits[I] := 0;
2485
2486 ClearExtraBits;
2487 end
2488 else
2489 begin
2490 for I := Count to fSize - 1 do
2491 SetBitFast(I - Count, TestFast(I));
2492
2493 for I := fSize - Count to fSize - 1 do
2494 SetBitFast(I, false);
2495 end;
2496 end;
2497
2498 {--- TBitSet.Test ---}
Testnull2499 function TBitSet.Test(Index: Integer): Boolean;
2500 begin
2501 if (Index < 0) or (Index >= fSize) then
2502 RaiseIndexOutOfRange;
2503 Result := TestFast(Index);
2504 end;
2505
2506 {--- TBitSet.TestFast ---}
TestFastnull2507 function TBitSet.TestFast(Index : Integer): Boolean;
2508 var
2509 Rank, NBit : Integer;
2510 begin
2511 Rank := Index div (SizeOf(Byte) * 8);
2512 NBit := Index mod (SizeOf(Byte) * 8);
2513
2514 Result := (fBits[Rank] and (1 shl NBit)) <> 0;
2515 end;
2516
2517 {--- TBitSet.ToInteger ---}
TBitSet.ToIntegernull2518 function TBitSet.ToInteger: Integer;
2519 var
2520 I, IMax : Integer;
2521 begin
2522 Result := 0;
2523
2524 IMax := Min(fSize - 1, SizeOf(Integer) * 8 - 1);
2525 for I := IMax downto 0 do
2526 begin
2527 Result := Result shl 1;
2528 if TestFast(I) then
2529 Result := Result or 1;
2530 end;
2531 end;
2532
2533 {--- TBitSet.ToInt64 ---}
TBitSet.ToInt64null2534 function TBitSet.ToInt64: Int64;
2535 begin
2536 Result := Int64(ToQWord);
2537 end;
2538
2539 {--- TBitSet.ToQWord ---}
ToQWordnull2540 function TBitSet.ToQWord: QWord;
2541 var
2542 I, IMax : Integer;
2543 begin
2544 Result := 0;
2545
2546 IMax := Min(fSize - 1, SizeOf(QWord) * 8 - 1);
2547 for I := IMax downto 0 do
2548 begin
2549 Result := Result shl 1;
2550 if TestFast(I) then
2551 Result := Result or 1;
2552 end;
2553 end;
2554
2555 {--- TBitSet.ToString ---}
TBitSet.ToStringnull2556 function TBitSet.ToString: String;
2557 var
2558 Bit : Char;
2559 I: Integer;
2560 begin
2561 SetLength(Result, fSize);
2562
2563 for I := 0 to fSize - 1 do
2564 begin
2565 if TestFast(I) then
2566 Bit := '1'
2567 else
2568 Bit := '0';
2569
2570 Result[fSize - I] := Bit;
2571 end;
2572 end;
2573
2574 {--- TBitSet.XorBits ---}
2575 procedure TBitSet.XorBits(BitSet: TBitSet);
2576 var
2577 I: Integer;
2578 begin
2579 if BitSet.fSize <> fSize then
2580 RaiseError(S_BitSetsAreIncompatible);
2581
2582 for I := 0 to fLen - 1 do
2583 fBits[I] := fBits[I] xor BitSet.fBits[I];
2584
2585 ClearExtraBits;
2586 end;
2587
2588 {$pop}
2589
2590 {======================}
2591 {=== TGenEnumerator ===}
2592 {======================}
2593
2594 {--- TGenEnumerator.GetCurrent ---}
GetCurrentnull2595 function TGenEnumerator.GetCurrent: _TItem_;
2596 begin
2597 Result := fGetter(fPos);
2598 end;
2599
2600 {--- TGenEnumerator.Create ---}
2601 constructor TGenEnumerator.Create(const Pos: _TPosition_; Mover: TMoveNext;
2602 Getter: TGetCurrent);
2603 begin
2604 fPos := Pos;
2605 fMover := Mover;
2606 fGetter := Getter;
2607 end;
2608
2609 {--- TGenEnumerator.MoveNext ---}
TGenEnumerator.MoveNextnull2610 function TGenEnumerator.MoveNext: Boolean;
2611 begin
2612 Result := fMover(fPos);
2613 end;
2614
2615 {==================}
2616 {=== TContainer ===}
2617 {==================}
2618
2619 {--- TContainer.RaiseContainerEmpty ---}
2620 procedure TContainer.RaiseContainerEmpty;
2621 begin
2622 raise EContainerError.Create(S_ContainerEmpty);
2623 end;
2624
2625 {--- TContainer.RaiseCursorDenotesWrongContainer ---}
2626 procedure TContainer.RaiseCursorDenotesWrongContainer;
2627 begin
2628 raise EContainerError.Create(S_CursorDenotesWrongContainer);
2629 end;
2630
2631 {--- TContainer.RaiseCursorIsNil ---}
2632 procedure TContainer.RaiseCursorIsNil;
2633 begin
2634 raise EContainerError.Create(S_CursorIsNil);
2635 end;
2636
2637 {--- TContainer.RaiseError ---}
2638 procedure TContainer.RaiseError(const Msg: String);
2639 begin
2640 raise EContainerError.Create(Msg);
2641 end;
2642
2643 {--- TContainer.RaiseIndexOutOfRange ---}
2644 procedure TContainer.RaiseIndexOutOfRange;
2645 begin
2646 raise EContainerError.Create(S_IndexOutOfRange);
2647 end;
2648
2649 {--- TContainer.RaiseItemAlreadyInSet ---}
2650 procedure TContainer.RaiseItemAlreadyInSet;
2651 begin
2652 raise EContainerError.Create(S_ItemAlreadyInSet);
2653 end;
2654
2655 {--- TContainer.RaiseItemNotInSet ---}
2656 procedure TContainer.RaiseItemNotInSet;
2657 begin
2658 raise EContainerError.Create(S_ItemNotInSet);
2659 end;
2660
2661 {--- TContainer.RaiseKeyAlreadyInMap ---}
2662 procedure TContainer.RaiseKeyAlreadyInMap;
2663 begin
2664 raise EContainerError.Create(S_KeyAlreadyInMap);
2665 end;
2666
2667 {--- TContainer.RaiseKeyNotInMap ---}
2668 procedure TContainer.RaiseKeyNotInMap;
2669 begin
2670 raise EContainerError.Create(S_KeyNotInMap);
2671 end;
2672
2673 {--- TContainer.RaiseMethodNotRedefined ---}
2674 procedure TContainer.RaiseMethodNotRedefined;
2675 begin
2676 raise EContainerError.Create(S_MethodNotRedefined);
2677 end;
2678
2679 {--- TContainer.Unused ---}
2680 {$PUSH}
2681 {$HINTS OFF}
2682 procedure TContainer.Unused(P: Pointer); inline;
2683 begin
2684 end;
2685 {$POP}
2686
2687 {=======================}
2688 {=== TAbstractVector ===}
2689 {=======================}
2690
2691 {--- TAbstractVector.CheckIndex ---}
2692 procedure TAbstractVector.CheckIndex(Index: Integer);
2693 begin
2694 if (Index < 0) or (Index >= fSize) then
2695 RaiseIndexOutOfRange;
2696 end;
2697
2698 {--- TAbstractVector.CheckIndexForAdd ---}
2699 procedure TAbstractVector.CheckIndexForAdd(Index: Integer);
2700 begin
2701 if (Index < 0) or (Index > fSize) then
2702 RaiseIndexOutOfRange;
2703 end;
2704
2705 {--- TAbstractVector.Clear ---}
2706 procedure TAbstractVector.Clear;
2707 begin
2708 Resize(0);
2709 end;
2710
2711 {--- TAbstractVector.Delete ---}
2712 procedure TAbstractVector.Delete(Position: Integer; Count: Integer);
2713 var
2714 CountAtEnd: Integer;
2715 begin
2716 CheckIndex(Position);
2717
2718 if Position + Count > fSize then
2719 Count := fSize - Position;
2720
2721 if Count > 0 then
2722 begin
2723 CountAtEnd := fSize - (Position + Count);
2724 if CountAtEnd > 0 then
2725 Move(Position + Count, Position, CountAtEnd);
2726
2727 fSize := fSize - Count;
2728 end;
2729 end;
2730
2731 {--- TAbstractVector.DeleteFirst ---}
2732 procedure TAbstractVector.DeleteFirst(Count: Integer);
2733 begin
2734 if Count > 0 then
2735 Delete(0, Count);
2736 end;
2737
2738 {--- TAbstractVector.DeleteLast ---}
2739 procedure TAbstractVector.DeleteLast(Count: Integer);
2740 begin
2741 if Count > 0 then
2742 Resize(fSize - Count);
2743 end;
2744
2745 {--- TAbstractVector.DeleteRange ---}
2746 procedure TAbstractVector.DeleteRange(PosFrom, PosTo: Integer);
2747 begin
2748 CheckIndex(PosFrom);
2749 CheckIndex(PosTo);
2750
2751 if PosTo >= PosFrom then
2752 Delete(PosFrom, PosTo - PosFrom + 1);
2753 end;
2754
2755 {--- TAbstractVector.InsertSpace ---}
2756 procedure TAbstractVector.InsertSpace(Position: Integer; Count: Integer);
2757 begin
2758 CheckIndexForAdd(Position);
2759 InsertSpaceFast(Position, Count);
2760 end;
2761
2762 {--- TAbstractVector.IsEmpty ---}
IsEmptynull2763 function TAbstractVector.IsEmpty: Boolean;
2764 begin
2765 Result := (fSize = 0);
2766 end;
2767
2768 {--- TAbstractVector.Reserve ---}
2769 procedure TAbstractVector.Reserve(MinCapacity: Integer);
2770 var
2771 NewCapacity : Integer;
2772 begin
2773 if MinCapacity > Capacity then
2774 begin
2775 NewCapacity := (Capacity * 3) div 2;
2776 if NewCapacity < MinCapacity then
2777 NewCapacity := MinCapacity;
2778 SetCapacity(NewCapacity);
2779 end;
2780 end;
2781
2782 {--- TAbstractVector.Resize ---}
2783 procedure TAbstractVector.Resize(NewSize: Integer);
2784 begin
2785 if NewSize > fSize then
2786 Reserve(NewSize);
2787
2788 if NewSize < 0 then
2789 NewSize := 0;
2790
2791 fSize := NewSize;
2792 end;
2793
2794 {--- TAbstractVector.Reverse ---}
2795 procedure TAbstractVector.Reverse;
2796 begin
2797 if fSize > 1 then
2798 ReverseRange(0, fSize - 1);
2799 end;
2800
2801 {--- TAbstractVector.ReverseRange ---}
2802 procedure TAbstractVector.ReverseRange(PosFrom, PosTo: Integer);
2803 var
2804 TmpIndex : Integer;
2805 begin
2806 CheckIndex(PosFrom);
2807 CheckIndex(PosTo);
2808
2809 if PosTo < PosFrom then
2810 begin
2811 TmpIndex := PosFrom;
2812 PosFrom := PosTo;
2813 PosTo := TmpIndex;
2814 end;
2815
2816 while PosFrom < PosTo do
2817 begin
2818 SwapFast(PosFrom, PosTo);
2819 Inc(PosFrom);
2820 Dec(PosTo);
2821 end;
2822 end;
2823
2824 {--- TAbstractVector.Shuffle ---}
2825 procedure TAbstractVector.Shuffle;
2826 begin
2827 if fSize > 1 then
2828 Shuffle(0, fSize - 1);
2829 end;
2830
2831 {--- TAbstractVector.Shuffle ---}
2832 procedure TAbstractVector.Shuffle(PosFrom, PosTo: Integer);
2833 var
2834 I, J: Integer;
2835 begin
2836 CheckIndex(PosFrom);
2837 CheckIndex(PosTo);
2838
2839 I := PosTo;
2840 while I > PosFrom do
2841 begin
2842 J := Random(I - PosFrom) + PosFrom;
2843 if J <> I then
2844 SwapFast(J, I);
2845 Dec(I);
2846 end;
2847 end;
2848
2849 {--- TAbstractVector.Swap ---}
2850 procedure TAbstractVector.Swap(I, J: Integer);
2851 begin
2852 CheckIndex(I);
2853 CheckIndex(J);
2854 SwapFast(I, J);
2855 end;
2856
2857 {--- TAbstractVector.ToString ---}
TAbstractVector.ToStringnull2858 function TAbstractVector.ToString: String;
2859 var
2860 I : Integer;
2861 begin
2862 Result := '[';
2863
2864 if fSize > 0 then
2865 begin
2866 for I := 0 to fSize - 2 do
2867 Result := Result + ItemToString(I) + ', ';
2868 Result := Result + ItemToString(fSize - 1);
2869 end;
2870
2871 Result := Result + ']';
2872 end;
2873
2874 {==================}
2875 {=== TGenVector ===}
2876 {==================}
2877
2878 {--- TGenVector.Append ---}
2879 procedure TGenVector.Append(const Item: _TItem_);
2880 begin
2881 Insert(fSize, Item);
2882 end;
2883
2884 {--- TGenVector.AppendAll ---}
2885 procedure TGenVector.AppendAll(Src: TGenVector);
2886 begin
2887 InsertAll(fSize, Src);
2888 end;
2889
2890 {--- TGenVector.AppendRange ---}
2891 procedure TGenVector.AppendRange(Src: TGenVector; PosFrom, PosTo: Integer);
2892 begin
2893 InsertRange(fSize, Src, PosFrom, PosTo);
2894 end;
2895
2896 {--- TGenVector.BinarySearch ---}
BinarySearchnull2897 function TGenVector.BinarySearch(const Item: _TItem_): Integer;
2898 begin
2899 Result := BinarySearch(Item, fOnCompareItems);
2900 end;
2901
2902 {--- TGenVector.BinarySearch ---}
BinarySearchnull2903 function TGenVector.BinarySearch(const Item: _TItem_; Comparator: TCompareItems): Integer;
2904 begin
2905 if fSize > 0 then
2906 Result := BinarySearch(Item, 0, fSize - 1, Comparator)
2907 else
2908 Result := -1;
2909 end;
2910
2911 {--- TGenVector.BinarySearch ---}
BinarySearchnull2912 function TGenVector.BinarySearch(const Item: _TItem_;
2913 PosFrom, PosTo: Integer): Integer;
2914 begin
2915 Result := BinarySearch(Item, PosFrom, PosTo, fOnCompareItems);
2916 end;
2917
2918 {--- TGenVector.BinarySearch ---}
BinarySearchnull2919 function TGenVector.BinarySearch(const Item: _TItem_;
2920 PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
2921 var
2922 Low, Mid, High, Cmp : Integer;
2923 begin
2924 CheckIndex(PosFrom);
2925 CheckIndex(PosTo);
2926
2927 Low := PosFrom;
2928 Mid := -1;
2929 High := PosTo;
2930
2931 while Low <= High do
2932 begin
2933 Mid := (Low + High) div 2;
2934 Cmp := Comparator(fItems[Mid], Item);
2935
2936 if Cmp = 0 then
2937 begin
2938 Result := Mid;
2939 Exit;
2940 end;
2941
2942 if Cmp < 0 then
2943 Low := Mid + 1
2944 else
2945 High := Mid - 1;
2946 end;
2947
2948 if Mid < 0 then
2949 Result := -1
2950 else if Comparator(fItems[Mid], Item) > 0 then
2951 Result := - Mid - 1
2952 else
2953 Result := - Mid - 2;
2954 end;
2955
2956 {--- TGenVector.DefaultCompareItems ---}
TGenVector.DefaultCompareItemsnull2957 function TGenVector.DefaultCompareItems(const A, B: _TItem_): Integer;
2958 begin
2959 Unused(@A);
2960 Unused(@B);
2961 RaiseMethodNotRedefined;
2962 Result := 0;
2963 end;
2964
2965 {--- TGenVector.Contains ---}
Containsnull2966 function TGenVector.Contains(const Item: _TItem_): Boolean;
2967 begin
2968 Result := Contains(Item, fOnCompareItems);
2969 end;
2970
2971 {--- TGenVector.Contains ---}
Containsnull2972 function TGenVector.Contains(const Item: _TItem_; Comparator: TCompareItems): Boolean;
2973 begin
2974 if fSize = 0 then
2975 Result := false
2976 else
2977 Result := (FindIndex(Item, 0, Comparator) >= 0);
2978 end;
2979
2980 {--- TGenVector.Create ---}
2981 constructor TGenVector.Create(InitialCapacity: Integer);
2982 begin
2983 if InitialCapacity < 0 then
2984 InitialCapacity := 16;
2985
2986 fSize := 0;
2987
2988 SetCapacity(InitialCapacity);
2989
2990 SetOnCompareItems(nil);
2991 SetOnItemToString(nil);
2992 end;
2993
2994 {--- TGenVector.Destroy ---}
2995 destructor TGenVector.Destroy;
2996 begin
2997 SetCapacity(0);
2998 inherited Destroy;
2999 end;
3000
3001 {--- TGenVector.Equals ---}
TGenVector.Equalsnull3002 function TGenVector.Equals(Obj: TObject): Boolean;
3003 begin
3004 Result := Equals(Obj, fOnCompareItems);
3005 end;
3006
3007 {--- TGenVector.Equals ---}
TGenVector.Equalsnull3008 function TGenVector.Equals(Obj: TObject; Comparator: TCompareItems): Boolean;
3009 var
3010 Vector: TGenVector;
3011 I : Integer;
3012 begin
3013 if Obj = Self then
3014 Result := true
3015 else if Obj is TGenVector then
3016 begin
3017 Vector := Obj as TGenVector;
3018
3019 if fSize <> Vector.fSize then
3020 Result := false
3021 else
3022 begin
3023 Result := true;
3024 for I := 0 to fSize - 1 do
3025 if Comparator(fItems[I], Vector.fItems[I]) <> 0 then
3026 begin
3027 Result := false;
3028 Break;
3029 end;
3030 end;
3031 end
3032 else
3033 Result := false;
3034 end;
3035
3036 {--- TGenVector.EnumeratorGet ---}
EnumeratorGetnull3037 function TGenVector.EnumeratorGet(const Pos: Integer): _TItem_;
3038 begin
3039 Result := fItems[Pos];
3040 end;
3041
3042 {--- TGenVector.EnumeratorNext ---}
TGenVector.EnumeratorNextnull3043 function TGenVector.EnumeratorNext(var Pos: Integer): Boolean;
3044 begin
3045 Inc(Pos);
3046 Result := Pos < fSize;
3047 end;
3048
3049 {--- TGenVector.Fill ---}
3050 procedure TGenVector.Fill(Index, Count: Integer; const Value: _TItem_);
3051 var
3052 I: Integer;
3053 begin
3054 if Count > 0 then
3055 for I := Index to Index + (Count - 1) do
3056 fItems[I] := Value;
3057 end;
3058
3059 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3060 function TGenVector.FindIndex(const Item: _TItem_): Integer;
3061 begin
3062 Result := FindIndex(Item, fOnCompareItems);
3063 end;
3064
3065 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3066 function TGenVector.FindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
3067 begin
3068 if fSize = 0 then
3069 Result := -1
3070 else
3071 Result := FindIndex(Item, 0, Comparator);
3072 end;
3073
3074 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3075 function TGenVector.FindIndex(const Item: _TItem_; PosFrom: Integer): Integer;
3076 begin
3077 Result := FindIndex(Item, PosFrom, fOnCompareItems);
3078 end;
3079
3080 {--- TGenVector.FindIndex ---}
TGenVector.FindIndexnull3081 function TGenVector.FindIndex(const Item: _TItem_; PosFrom: Integer; Comparator: TCompareItems): Integer;
3082 var
3083 I: Integer;
3084 begin
3085 CheckIndex(PosFrom);
3086
3087 Result := -1;
3088
3089 for I := PosFrom to fSize - 1 do
3090 if Comparator(fItems[I], Item) = 0 then
3091 begin
3092 Result := I;
3093 Break;
3094 end;
3095 end;
3096
3097 {--- TGenVector.FirstItem ---}
FirstItemnull3098 function TGenVector.FirstItem: _TItem_;
3099 begin
3100 if fSize = 0 then
3101 RaiseContainerEmpty;
3102
3103 Result := fItems[0];
3104 end;
3105
3106 {--- TGenVector.GetEnumerator ---}
TGenVector.GetEnumeratornull3107 function TGenVector.GetEnumerator: TEnumerator;
3108 begin
3109 Result := TEnumerator.Create(-1, @EnumeratorNext, @EnumeratorGet);
3110 end;
3111
3112 {--- TGenVector.GetItem ---}
GetItemnull3113 function TGenVector.GetItem(Position: Integer): _TItem_;
3114 begin
3115 CheckIndex(Position);
3116 Result := fItems[Position];
3117 end;
3118
3119 {--- TGenVector.GetItemFast ---}
TGenVector.GetItemFastnull3120 function TGenVector.GetItemFast(Position: Integer): _TItem_;
3121 begin
3122 Result := fItems[Position];
3123 end;
3124
3125 {--- TGenVector.GetItemPtr ---}
TGenVector.GetItemPtrnull3126 function TGenVector.GetItemPtr(Position: Integer): PItem;
3127 begin
3128 CheckIndex(Position);
3129 Result := @fItems[Position];
3130 end;
3131
3132 {--- TGenVector.GetItemPtrFast ---}
TGenVector.GetItemPtrFastnull3133 function TGenVector.GetItemPtrFast(Position: Integer): PItem;
3134 begin
3135 Result := @fItems[Position];
3136 end;
3137
3138 {--- TGenVector.Insert ---}
3139 procedure TGenVector.Insert(Before: Integer; const Item: _TItem_; Count: Integer);
3140 begin
3141 CheckIndexForAdd(Before);
3142
3143 if Count > 0 then
3144 begin
3145 InsertSpaceFast(Before, Count);
3146 Fill(Before, Count, Item);
3147 end;
3148 end;
3149
3150 {--- TGenVector.InsertAll ---}
3151 procedure TGenVector.InsertAll(Before: Integer; Src: TGenVector);
3152 begin
3153 if Src.fSize > 0 then
3154 InsertRange(Before, Src, 0, Src.fSize - 1);
3155 end;
3156
3157 {--- TGenVector.InsertionSort ---}
3158 procedure TGenVector.InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
3159 var
3160 I, J : Integer;
3161 Tmp, Item : _TItem_;
3162 begin
3163 if PosFrom >= PosTo then
3164 Exit;
3165
3166 for I := PosFrom + 1 to PosTo do
3167 begin
3168 Tmp := fItems[I];
3169
3170 J := I - 1;
3171 while (J >= PosFrom) do
3172 begin
3173 Item := fItems[J];
3174 if Comparator(Item, Tmp) <= 0 then
3175 Break;
3176 fItems[J + 1] := fItems[J];
3177 Dec(J);
3178 end;
3179
3180 fItems[J + 1] := Tmp;
3181 end;
3182 end;
3183
3184 {--- TGenVector.Quicksort ---}
3185 procedure TGenVector.Quicksort(Left, Right: Integer; Comparator: TCompareItems);
3186 var
3187 I, J : Integer;
3188 Pivot : _TItem_;
3189 Begin
3190 if Right - Left <= 15 then
3191 begin
3192 InsertionSort(Left, Right, Comparator);
3193 Exit;
3194 end;
3195
3196 I := Left;
3197 J := Right;
3198 Pivot := fItems[(Left + Right) div 2];
3199 repeat
3200 while Comparator(Pivot, fItems[I]) > 0 do
3201 Inc(I);
3202
3203 while Comparator(Pivot, fItems[J]) < 0 do
3204 Dec(J);
3205
3206 if I <= J then
3207 begin
3208 SwapFast(I, J);
3209 Dec(J);
3210 Inc(I);
3211 end;
3212 until I > J;
3213
3214 if Left < J then
3215 QuickSort(Left, J, Comparator);
3216
3217 if I < Right then
3218 QuickSort(I, Right, Comparator);
3219 end;
3220
3221 {--- TGenVector.InsertRange ---}
3222 procedure TGenVector.InsertRange(Before: Integer; Src: TGenVector;
3223 PosFrom, PosTo: Integer);
3224 var
3225 Count : Integer;
3226 begin
3227 CheckIndexForAdd(Before);
3228 Src.CheckIndex(PosFrom);
3229 Src.CheckIndex(PosTo);
3230
3231 Count := PosTo - PosFrom + 1;
3232 if Count > 0 then
3233 begin
3234 InsertSpaceFast(Before, Count);
3235 RealMove(Src, Self, PosFrom, Before, Count);
3236 end;
3237 end;
3238
3239 {--- TGenVector.InsertSpaceFast ---}
3240 procedure TGenVector.InsertSpaceFast(Position, Count: Integer);
3241 var
3242 ItemsAfterPos : Integer;
3243 begin
3244 if Count > 0 then
3245 begin
3246 ItemsAfterPos := fSize - Position;
3247 Resize(fSize + Count);
3248 if ItemsAfterPos > 0 then
3249 Move(Position, Position + Count, ItemsAfterPos);
3250 end;
3251 end;
3252
3253 {--- TGenVector.ItemToString ---}
TGenVector.ItemToStringnull3254 function TGenVector.ItemToString(Index: Integer): String;
3255 begin
3256 Result := fOnItemToString(fItems[Index]);
3257 end;
3258
3259 {--- TGenVector.IsSorted ---}
IsSortednull3260 function TGenVector.IsSorted : Boolean;
3261 begin
3262 Result := IsSorted(fOnCompareItems);
3263 end;
3264
3265 {--- TGenVector.IsSorted ---}
IsSortednull3266 function TGenVector.IsSorted(Comparator: TCompareItems): Boolean;
3267 var
3268 I : Integer;
3269 begin
3270 Result := true;
3271
3272 if fSize > 1 then
3273 for I := 1 to fSize - 1 do
3274 if Comparator(fItems[I], fItems[I - 1]) < 0 then
3275 begin
3276 Result := false;
3277 Break;
3278 end;
3279 end;
3280
3281 {--- TGenVector.DefaultItemToString ---}
TGenVector.DefaultItemToStringnull3282 function TGenVector.DefaultItemToString(const Item: _TItem_): String;
3283 begin
3284 Unused(@Item);
3285 RaiseMethodNotRedefined;
3286 Result := '';
3287 end;
3288
3289 {--- TGenVector.Iterate ---}
3290 procedure TGenVector.Iterate(Process: TProcessItem);
3291 begin
3292 Iterate(Process, 0, fSize - 1);
3293 end;
3294
3295 {--- TGenVector.Iterate ---}
3296 procedure TGenVector.Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
3297 var
3298 I : Integer;
3299 P : PItem;
3300 begin
3301 CheckIndex(PosFrom);
3302 CheckIndex(PosTo);
3303
3304 P := @fItems[PosFrom];
3305 for I := PosFrom to PosTo do
3306 begin
3307 Process(P^);
3308 P := P + 1;
3309 end;
3310 end;
3311
3312 {--- TGenVector.LastItem ---}
LastItemnull3313 function TGenVector.LastItem: _TItem_;
3314 begin
3315 if fSize = 0 then
3316 RaiseContainerEmpty;
3317
3318 Result := fItems[fSize - 1];
3319 end;
3320
3321 {--- TGenVector.MaxPos ---}
MaxPosnull3322 function TGenVector.MaxPos(PosFrom, PosTo: Integer): Integer;
3323 begin
3324 Result := MaxPos(PosFrom, PosTo, fOnCompareItems);
3325 end;
3326
3327 {--- TGenVector.MaxPos ---}
MaxPosnull3328 function TGenVector.MaxPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
3329 var
3330 I : Integer;
3331 Max : _TItem_;
3332 begin
3333 CheckIndex(PosFrom);
3334 CheckIndex(PosTo);
3335
3336 if PosTo < PosFrom then
3337 begin
3338 I := PosFrom;
3339 PosFrom := PosTo;
3340 PosTo := I;
3341 end;
3342
3343 Max := fItems[PosFrom];
3344 Result := PosFrom;
3345 for I := PosFrom + 1 to PosTo do
3346 if Comparator(fItems[I], Max) > 0 then
3347 begin
3348 Result := I;
3349 Max := fItems[I];
3350 end;
3351 end;
3352
3353 {--- TGenVector.MaxPos ---}
MaxPosnull3354 function TGenVector.MaxPos : Integer;
3355 begin
3356 Result := MaxPos(fOnCompareItems);
3357 end;
3358
3359 {--- TGenVector.MaxPos ---}
MaxPosnull3360 function TGenVector.MaxPos(Comparator: TCompareItems): Integer;
3361 begin
3362 if fSize = 0 then
3363 RaiseContainerEmpty;
3364
3365 Result := MaxPos(0, fSize - 1, Comparator);
3366 end;
3367
3368 {--- TGenVector.Merge ---}
3369 procedure TGenVector.Merge(Src: TGenVector);
3370 begin
3371 Merge(Src, fOnCompareItems);
3372 end;
3373
3374 {--- TGenVector.Merge ---}
3375 procedure TGenVector.Merge(Src: TGenVector; Comparator: TCompareItems);
3376 var
3377 A, B, C : Integer;
3378 begin
3379 if Src.fSize = 0 then
3380 Exit;
3381
3382 if fSize = 0 then
3383 AppendAll(Src)
3384 else if Comparator(Src.FirstItem, LastItem) >= 0 then
3385 AppendAll(Src)
3386 else if Comparator(FirstItem, Src.LastItem) >= 0 then
3387 PrependAll(Src)
3388 else
3389 begin
3390 A := fSize - 1;
3391 B := Src.fSize - 1;
3392
3393 InsertSpace(fSize, Src.fSize);
3394 C := fSize - 1;
3395
3396 while C > 0 do
3397 begin
3398 if Comparator(fItems[A], Src.fItems[B]) > 0 then
3399 begin
3400 fItems[C] := fItems[A];
3401 Dec(A);
3402 if A < 0 then
3403 Break;
3404 end
3405 else
3406 begin
3407 fItems[C] := Src.fItems[B];
3408 Dec(B);
3409 if B < 0 then
3410 Break;
3411 end;
3412 Dec(C);
3413 end;
3414
3415 if (C >= 0) and (B >= 0) then
3416 while B >= 0 do
3417 begin
3418 fItems[B] := Src.fItems[B];
3419 Dec(B);
3420 end;
3421
3422 end;
3423 Src.Clear;
3424 end;
3425
3426 {--- TGenVector.MinPos ---}
MinPosnull3427 function TGenVector.MinPos(PosFrom, PosTo: Integer): Integer;
3428 begin
3429 Result := MinPos(PosFrom, PosTo, fOnCompareItems);
3430 end;
3431
3432 {--- TGenVector.MinPos ---}
MinPosnull3433 function TGenVector.MinPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
3434 var
3435 I : Integer;
3436 Min : _TItem_;
3437 begin
3438 CheckIndex(PosFrom);
3439 CheckIndex(PosTo);
3440
3441 if PosTo < PosFrom then
3442 begin
3443 I := PosFrom;
3444 PosFrom := PosTo;
3445 PosTo := I;
3446 end;
3447
3448 Result := -1;
3449 Min := fItems[PosFrom];
3450 Result := PosFrom;
3451 for I := PosFrom + 1 to PosTo do
3452 if Comparator(fItems[I], Min) < 0 then
3453 begin
3454 Result := I;
3455 Min := fItems[I];
3456 end;
3457 end;
3458
3459 {--- TGenVector.MinPos ---}
MinPosnull3460 function TGenVector.MinPos : Integer;
3461 begin
3462 Result := MinPos(fOnCompareItems);
3463 end;
3464
3465 {--- TGenVector.MinPos ---}
MinPosnull3466 function TGenVector.MinPos(Comparator: TCompareItems): Integer;
3467 begin
3468 if fSize = 0 then
3469 RaiseContainerEmpty;
3470
3471 Result := MinPos(0, fSize - 1, Comparator);
3472 end;
3473
3474 {--- TGenVector.Move ---}
3475 procedure TGenVector.Move(Src, Dst, Count: Integer);
3476 begin
3477 CheckIndex(Src);
3478 CheckIndex(Dst);
3479
3480 if Count > 0 then
3481 begin
3482 if Src + Count > fSize then
3483 Count := fSize - Src;
3484
3485 if Dst + Count > fSize then
3486 Count := fSize - Dst;
3487
3488 if Count > 0 then
3489 RealMove(Self, Self, Src, Dst, Count);
3490 end;
3491 end;
3492
3493 {--- TGenVector.Prepend ---}
3494 procedure TGenVector.Prepend(const Item: _TItem_; Count: Integer);
3495 begin
3496 Insert(0, Item, Count);
3497 end;
3498
3499 {--- TGenVector.PrependAll ---}
3500 procedure TGenVector.PrependAll(Src: TGenVector);
3501 begin
3502 InsertAll(0, Src);
3503 end;
3504
3505 {--- TGenVector.PrependRange ---}
3506 procedure TGenVector.PrependRange(Src: TGenVector; PosFrom, PosTo: Integer);
3507 begin
3508 InsertRange(0, Src, PosFrom, PosTo);
3509 end;
3510
3511 {--- TGenVector.ReadFirstItem ---}
3512 procedure TGenVector.ReadFirstItem(out Value : _TItem_);
3513 begin
3514 if fSize = 0 then
3515 RaiseContainerEmpty;
3516
3517 Value := fItems[0];
3518 end;
3519
3520 {--- TGenVector.ReadItem ---}
3521 procedure TGenVector.ReadItem(Position: Integer; out Value: _TItem_);
3522 begin
3523 CheckIndex(Position);
3524 Value := fItems[Position];
3525 end;
3526
3527 {--- TGenVector.ReadItemFast ---}
3528 procedure TGenVector.ReadItemFast(Position: Integer; out Value: _TItem_);
3529 begin
3530 Value := fItems[Position];
3531 end;
3532
3533 {--- TGenVector.ReadLastItem ---}
3534 procedure TGenVector.ReadLastItem(out Value : _TItem_);
3535 begin
3536 if fSize = 0 then
3537 RaiseContainerEmpty;
3538
3539 Value := fItems[fSize - 1];
3540 end;
3541
3542 {--- TGenVector.Sort ---}
3543 procedure TGenVector.Sort(PosFrom, PosTo: Integer);
3544 begin
3545 Sort(PosFrom, PosTo, fOnCompareItems);
3546 end;
3547
3548 {--- TGenVector.Sort ---}
3549 procedure TGenVector.Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
3550 begin
3551 CheckIndex(PosFrom);
3552 CheckIndex(PosTo);
3553
3554 if PosFrom >= PosTo then
3555 Exit;
3556
3557 Quicksort(PosFrom, PosTo, Comparator);
3558 end;
3559
3560 {--- TGenVector.Sort ---}
3561 procedure TGenVector.Sort;
3562 begin
3563 Sort(fOnCompareItems);
3564 end;
3565
3566 {--- TGenVector.Sort ---}
3567 procedure TGenVector.Sort(Comparator: TCompareItems);
3568 begin
3569 if fSize > 1 then
3570 Sort(0, fSize - 1, Comparator);
3571 end;
3572
3573 {--- TGenVector.RealMove ---}
3574 class procedure TGenVector.RealMove(Src, Dst: TGenVector;
3575 SrcFirst, DstFirst, Count: Integer);
3576 var
3577 SrcLast, I, DstCurrent: Integer;
3578 begin
3579 SrcLast := SrcFirst + Count - 1;
3580 if (Src = Dst) and ( (DstFirst >= SrcFirst) and (DstFirst <= SrcLast) ) then
3581 begin
3582 DstCurrent := DstFirst + Count - 1;
3583 for I := SrcLast downto SrcFirst do
3584 begin
3585 Dst.fItems[DstCurrent] := Src.fItems[I];
3586 Dec(DstCurrent);
3587 end
3588 end
3589 else
3590 begin
3591 DstCurrent := DstFirst;
3592 for I := SrcFirst to SrcLast do
3593 begin
3594 Dst.fItems[DstCurrent] := Src.fItems[I];
3595 Inc(DstCurrent);
3596 end;
3597 end;
3598 end;
3599
3600 {--- TGenVector.Replace ---}
3601 procedure TGenVector.Replace(Index, Count: Integer; const Value: _TItem_);
3602 begin
3603 CheckIndex(Index);
3604
3605 if Count > 0 then
3606 begin
3607 if Index + Count >= fSize then
3608 Count := fSize - Index;
3609
3610 if Count > 0 then
3611 Fill(Index, Count, Value);
3612 end;
3613 end;
3614
3615 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3616 function TGenVector.ReverseFindIndex(const Item: _TItem_): Integer;
3617 begin
3618 Result := ReverseFindIndex(Item, fOnCompareItems);
3619 end;
3620
3621 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3622 function TGenVector.ReverseFindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
3623 begin
3624 if fSize = 0 then
3625 Result := -1
3626 else
3627 Result := ReverseFindIndex(Item, fSize - 1, Comparator);
3628 end;
3629
3630 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3631 function TGenVector.ReverseFindIndex(const Item: _TItem_;
3632 PosFrom: Integer): Integer;
3633 begin
3634 Result := ReverseFindIndex(Item, PosFrom, fOnCompareItems);
3635 end;
3636
3637 {--- TGenVector.ReverseFindIndex ---}
ReverseFindIndexnull3638 function TGenVector.ReverseFindIndex(const Item: _TItem_;
3639 PosFrom: Integer; Comparator: TCompareItems): Integer;
3640 var
3641 I: Integer;
3642 begin
3643 CheckIndex(PosFrom);
3644
3645 Result := -1;
3646 for I := PosFrom downto 0 do
3647 if Comparator(fItems[I], Item) = 0 then
3648 begin
3649 Result := I;
3650 Break;
3651 end;
3652 end;
3653
3654 {--- TGenVector.SetCapacity ---}
3655 procedure TGenVector.SetCapacity(ACapacity: Integer);
3656 begin
3657 SetLength(fItems, ACapacity);
3658 fCapacity := ACapacity;
3659 end;
3660
3661 {--- TGenVector.SetOnCompareItems ---}
3662 procedure TGenVector.SetOnCompareItems(AValue: TCompareItems);
3663 begin
3664 if AValue = nil then
3665 fOnCompareItems := @DefaultCompareItems
3666 else
3667 fOnCompareItems := AValue;
3668 end;
3669
3670 {--- TGenVector.SetOnItemToString ---}
3671 procedure TGenVector.SetOnItemToString(AValue: TItemToString);
3672 begin
3673 if AValue = nil then
3674 fOnItemToString := @DefaultItemToString
3675 else
3676 fOnItemToString := AValue;
3677 end;
3678
3679 {--- TGenVector.SetItem ---}
3680 procedure TGenVector.SetItem(Position: Integer; const Value: _TItem_);
3681 begin
3682 CheckIndex(Position);
3683 fItems[Position] := Value;
3684 end;
3685
3686 {--- TGenVector.SetItemFast ---}
3687 procedure TGenVector.SetItemFast(Position: Integer; const Value: _TItem_);
3688 begin
3689 fItems[Position] := Value;
3690 end;
3691
3692 {--- TGenVector.SwapFast ---}
3693 procedure TGenVector.SwapFast(I, J: Integer);
3694 var
3695 Temp: _TItem_;
3696 begin
3697 Temp := fItems[I];
3698 fItems[I] := fItems[J];
3699 fItems[J] := Temp;
3700 end;
3701
3702 {=================}
3703 {=== TGenDeque ===}
3704 {=================}
3705
3706 {--- TGenDeque.Append ---}
3707 procedure TGenDeque.Append(const Item: _TItem_; Count: Integer);
3708 begin
3709 Insert(fSize, Item, Count);
3710 end;
3711
3712 {--- TGenDeque.AppendAll ---}
3713 procedure TGenDeque.AppendAll(Src: TGenDeque);
3714 begin
3715 InsertAll(fSize, Src);
3716 end;
3717
3718 {--- TGenDeque.AppendRange ---}
3719 procedure TGenDeque.AppendRange(Src: TGenDeque; PosFrom, PosTo: Integer);
3720 begin
3721 InsertRange(fSize, Src, PosFrom, PosTo);
3722 end;
3723
3724 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3725 function TGenDeque.BinarySearch(const Item: _TItem_): Integer;
3726 begin
3727 Result := BinarySearch(Item, fOnCompareItems);
3728 end;
3729
3730 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3731 function TGenDeque.BinarySearch(const Item: _TItem_; Comparator: TCompareItems): Integer;
3732 begin
3733 if fSize > 0 then
3734 Result := BinarySearch(Item, 0, fSize - 1, Comparator)
3735 else
3736 Result := -1;
3737 end;
3738
3739 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3740 function TGenDeque.BinarySearch(const Item: _TItem_; PosFrom, PosTo: Integer): Integer;
3741 begin
3742 Result := BinarySearch(Item, PosFrom, PosTo, fOnCompareItems);
3743 end;
3744
3745 {--- TGenDeque.BinarySearch ---}
BinarySearchnull3746 function TGenDeque.BinarySearch(const Item: _TItem_;
3747 PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
3748 var
3749 Low, Mid, High, Cmp: Integer;
3750 begin
3751 CheckIndex(PosFrom);
3752 CheckIndex(PosTo);
3753
3754 Low := PosFrom;
3755 Mid := -1;
3756 High := PosTo;
3757
3758 while Low <= High do
3759 begin
3760 Mid := (Low + High) div 2;
3761 Cmp := Comparator(fItems[ IndexToRank(Mid) ], Item);
3762
3763 if Cmp = 0 then
3764 begin
3765 Result := Mid;
3766 Exit;
3767 end;
3768
3769 if Cmp < 0 then
3770 Low := Mid + 1
3771 else
3772 High := Mid - 1;
3773 end;
3774
3775 if Mid < 0 then
3776 Result := -1
3777 else if Comparator(fItems[ IndexToRank(Mid) ], Item) > 0 then
3778 Result := - Mid - 1
3779 else
3780 Result := - Mid - 2;
3781 end;
3782
3783 {--- TGenDeque.DefaultCompareItems ---}
TGenDeque.DefaultCompareItemsnull3784 function TGenDeque.DefaultCompareItems(const A, B: _TItem_): Integer;
3785 begin
3786 Unused(@A);
3787 Unused(@B);
3788 RaiseMethodNotRedefined;
3789 Result := 0;
3790 end;
3791
3792 {--- TGenDeque.Contains ---}
Containsnull3793 function TGenDeque.Contains(const Item: _TItem_): Boolean;
3794 begin
3795 Result := Contains(Item, fOnCompareItems);
3796 end;
3797
3798 {--- TGenDeque.Contains ---}
Containsnull3799 function TGenDeque.Contains(const Item: _TItem_; Comparator: TCompareItems): Boolean;
3800 begin
3801 Result := (FindIndex(Item, Comparator) >= 0);
3802 end;
3803
3804 {--- TGenDeque.Create ---}
3805 constructor TGenDeque.Create(InitialCapacity: Integer);
3806 begin
3807 fSize := 0;
3808
3809 if InitialCapacity < 0 then
3810 InitialCapacity := 16;
3811
3812 fCapacity := InitialCapacity;
3813 SetLength(fItems, fCapacity);
3814
3815 fStart := 0;
3816
3817 SetOnCompareItems(nil);
3818 SetOnItemToString(nil);
3819 end;
3820
3821 {--- TGenDeque.Destroy ---}
3822 destructor TGenDeque.Destroy;
3823 begin
3824 SetLength(fItems, 0);
3825 inherited Destroy;
3826 end;
3827
3828 {--- TGenDeque.DecRank ---}
3829 procedure TGenDeque.DecRank(var Rank: Integer);
3830 begin
3831 if Rank = 0 then
3832 Rank := fCapacity - 1
3833 else
3834 Dec(Rank);
3835 end;
3836
3837 {--- TGenDeque.Equals ---}
Equalsnull3838 function TGenDeque.Equals(Deque: TGenDeque; Comparator: TCompareItems): Boolean;
3839 var
3840 I, IRank, JRank : Integer;
3841 begin
3842 if fSize <> Deque.fSize then
3843 Result := false
3844 else
3845 begin
3846 Result := true;
3847 IRank := fStart;
3848 JRank := Deque.fStart;
3849 for I := 0 to fSize - 1 do
3850 begin
3851 if Comparator(fItems[IRank], Deque.fItems[JRank]) <> 0 then
3852 begin
3853 Result := false;
3854 Break;
3855 end;
3856 IncRank(IRank);
3857 Deque.IncRank(JRank);
3858 end;
3859 end;
3860 end;
3861
3862 {--- TGenDeque.EnumeratorGet ---}
EnumeratorGetnull3863 function TGenDeque.EnumeratorGet(const Pos: Integer): _TItem_;
3864 begin
3865 Result := fItems[ IndexToRank(Pos) ];
3866 end;
3867
3868 {--- TGenDeque.EnumeratorNext ---}
EnumeratorNextnull3869 function TGenDeque.EnumeratorNext(var Pos: Integer): Boolean;
3870 begin
3871 Inc(Pos);
3872 Result := Pos < fSize;
3873 end;
3874
3875 {--- TGenDeque.Equals ---}
Equalsnull3876 function TGenDeque.Equals(Obj: TObject): Boolean;
3877 begin
3878 Result := Equals(Obj, fOnCompareItems);
3879 end;
3880
3881 {--- TGenDeque.Equals ---}
Equalsnull3882 function TGenDeque.Equals(Obj: TObject; Comparator: TCompareItems): Boolean;
3883 begin
3884 if Obj = Self then
3885 Result := true
3886 else if Obj is TGenDeque then
3887 Result := Equals(Obj as TGenDeque, Comparator)
3888 else
3889 Result := false;
3890 end;
3891
3892 {--- TGenDeque.FindIndex ---}
FindIndexnull3893 function TGenDeque.FindIndex(const Item: _TItem_): Integer;
3894 begin
3895 Result := FindIndex(Item, fOnCompareItems);
3896 end;
3897
3898 {--- TGenDeque.FindIndex ---}
FindIndexnull3899 function TGenDeque.FindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
3900 begin
3901 if fSize = 0 then
3902 Result := -1
3903 else
3904 Result := FindIndex(Item, 0, Comparator);
3905 end;
3906
3907 {--- TGenDeque.Fill ---}
3908 procedure TGenDeque.Fill(Index, Count: Integer; const Value: _TItem_);
3909 begin
3910 Index := IndexToRank(Index);
3911 while Count > 0 do
3912 begin
3913 fItems[Index] := Value;
3914 IncRank(Index);
3915 Dec(Count);
3916 end;
3917 end;
3918
3919 {--- TGenDeque.FindIndex ---}
FindIndexnull3920 function TGenDeque.FindIndex(const Item: _TItem_; PosFrom: Integer): Integer;
3921 begin
3922 Result := FindIndex(Item, PosFrom, fOnCompareItems);
3923 end;
3924
3925 {--- TGenDeque.FindIndex ---}
FindIndexnull3926 function TGenDeque.FindIndex(const Item: _TItem_; PosFrom: Integer; Comparator: TCompareItems): Integer;
3927 var
3928 I, Pos : Integer;
3929 begin
3930 CheckIndex(PosFrom);
3931
3932 Result := -1;
3933 Pos := IndexToRank(PosFrom);
3934 for I := PosFrom to fSize - 1 do
3935 begin
3936 if Comparator(fItems[Pos], Item) = 0 then
3937 begin
3938 Result := I;
3939 Break;
3940 end;
3941 IncRank(Pos);
3942 end;
3943 end;
3944
3945 {--- TGenDeque.FirstItem ---}
FirstItemnull3946 function TGenDeque.FirstItem: _TItem_;
3947 begin
3948 if fSize = 0 then
3949 RaiseContainerEmpty;
3950
3951 Result := fItems[fStart];
3952 end;
3953
3954 {--- TGenDeque.GetEnumerator ---}
TGenDeque.GetEnumeratornull3955 function TGenDeque.GetEnumerator: TEnumerator;
3956 begin
3957 Result := TEnumerator.Create(-1, @EnumeratorNext, @EnumeratorGet);
3958 end;
3959
3960 {--- TGenDeque.GetItem ---}
GetItemnull3961 function TGenDeque.GetItem(Position: Integer): _TItem_;
3962 begin
3963 CheckIndex(Position);
3964 Result := fItems[ IndexToRank(Position)];
3965 end;
3966
3967 {--- TGenDeque.GetItemPtr ---}
TGenDeque.GetItemPtrnull3968 function TGenDeque.GetItemPtr(Position: Integer): PItem;
3969 begin
3970 CheckIndex(Position);
3971 Result := @fItems[ IndexToRank(Position)];
3972 end;
3973
3974 {--- TGenDeque.GetItemFast ---}
GetItemFastnull3975 function TGenDeque.GetItemFast(Position: Integer): _TItem_;
3976 begin
3977 Result := fItems[ IndexToRank(Position) ];
3978 end;
3979
3980 {--- TGenDeque.GetItemPtrFast ---}
GetItemPtrFastnull3981 function TGenDeque.GetItemPtrFast(Position: Integer): PItem;
3982 begin
3983 Result := @fItems[ IndexToRank(Position) ];
3984 end;
3985
3986 {--- TGenDeque.IncRank ---}
3987 procedure TGenDeque.IncRank(var Rank: Integer);
3988 begin
3989 if Rank = fCapacity - 1 then
3990 Rank := 0
3991 else
3992 Inc(Rank);
3993 end;
3994
3995 {--- TGenDeque.IncreaseCapacity ---}
3996 procedure TGenDeque.IncreaseCapacity(ACapacity: Integer);
3997 var
3998 Dst : Integer;
3999 ItemsAtBegining, ItemsAtEnd : Integer;
4000 begin
4001 SetLength(fItems, ACapacity);
4002
4003 if fStart + fSize >= fCapacity then { Are items in 2 parts ? }
4004 begin
4005 ItemsAtEnd := fCapacity - fStart;
4006 ItemsAtBegining := fSize - ItemsAtEnd;
4007
4008 if ItemsAtEnd < ItemsAtBegining then
4009 begin
4010 Dst := ACapacity - ItemsAtEnd;
4011 RealMoveRank(fStart, Dst, ItemsAtEnd);
4012 fStart := Dst;
4013 end
4014 else
4015 begin
4016 Dst := fStart + ItemsAtEnd;
4017 RealMoveRank(0, Dst, ItemsAtBegining);
4018 end;
4019 end;
4020
4021 fCapacity := ACapacity;
4022 end;
4023
4024 {--- TGenDeque.IndexToRank ---}
IndexToRanknull4025 function TGenDeque.IndexToRank(Index: Integer): Integer;
4026 var
4027 AtEnd : Integer;
4028 begin
4029 AtEnd := fCapacity - fStart;
4030 if Index < AtEnd then
4031 Result := fStart + Index
4032 else
4033 Result := Index - AtEnd;
4034 end;
4035
4036 {--- TGenDeque.Insert ---}
4037 procedure TGenDeque.Insert(Before: Integer; const Item: _TItem_; Count: Integer);
4038 begin
4039 CheckIndexForAdd(Before);
4040
4041 if Count <= 0 then
4042 Exit;
4043
4044 InsertSpaceFast(Before, Count);
4045 Fill(Before, Count, Item);
4046 end;
4047
4048 {--- TGenDeque.InsertAll ---}
4049 procedure TGenDeque.InsertAll(Before: Integer; Src: TGenDeque);
4050 begin
4051 if Src.fSize > 0 then
4052 InsertRange(Before, Src, 0, Src.fSize - 1);
4053 end;
4054
4055 {--- TGenDeque.InsertionSort ---}
4056 procedure TGenDeque.InsertionSort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
4057 var
4058 I, J : Integer;
4059 IRank, JRank, NextJRank: Integer;
4060 Tmp, Item : _TItem_;
4061 begin
4062 if PosFrom >= PosTo then
4063 Exit;
4064
4065 IRank := IndexToRank(PosFrom + 1);
4066 for I := PosFrom + 1 to PosTo do
4067 begin
4068 Tmp := fItems[IRank];
4069
4070 J := I - 1;
4071 JRank := IRank;
4072 DecRank(JRank);
4073 while (J >= PosFrom) do
4074 begin
4075 Item := fItems[JRank];
4076 if Comparator(Item, Tmp) <= 0 then
4077 Break;
4078 NextJRank := JRank;
4079 IncRank(NextJRank);
4080 fItems[NextJRank] := fItems[JRank];
4081 Dec(J);
4082 DecRank(JRank);
4083 end;
4084
4085 fItems[IndexToRank(J + 1)] := Tmp;
4086 IncRank(IRank);
4087 end;
4088 end;
4089
4090 {--- TGenDeque.Quicksort ---}
4091 procedure TGenDeque.Quicksort(Left, Right: Integer; Comparator: TCompareItems);
4092 var
4093 I, J : Integer;
4094 Pivot : _TItem_;
4095 Begin
4096 if Right - Left <= 15 then
4097 begin
4098 InsertionSort(Left, Right, Comparator);
4099 Exit;
4100 end;
4101
4102 I := Left;
4103 J := Right;
4104 Pivot := fItems[ IndexToRank((Left + Right) div 2) ];
4105 repeat
4106 while Comparator(Pivot, fItems[IndexToRank(I)]) > 0 do
4107 Inc(I);
4108
4109 while Comparator(Pivot, fItems[IndexToRank(J)]) < 0 do
4110 Dec(J);
4111
4112 if I <= J then
4113 begin
4114 SwapFast(I, J);
4115 Dec(J);
4116 Inc(I);
4117 end;
4118 until I > J;
4119
4120 if Left < J then
4121 QuickSort(Left, J, Comparator);
4122
4123 if I < Right then
4124 QuickSort(I, Right, Comparator);
4125 end;
4126
4127 {--- TGenDeque.InsertRange ---}
4128 procedure TGenDeque.InsertRange(Before: Integer; Src: TGenDeque;
4129 PosFrom, PosTo: Integer);
4130 var
4131 Count : Integer;
4132 begin
4133 CheckIndexForAdd(Before);
4134 Src.CheckIndex(PosFrom);
4135 Src.CheckIndex(PosTo);
4136
4137 Count := PosTo - PosFrom + 1;
4138 if Count > 0 then
4139 begin
4140 InsertSpaceFast(Before, Count);
4141 RealMoveIndex(Src, Self, PosFrom, Before, Count);
4142 end;
4143 end;
4144
4145 {--- TGenDeque.InsertSpaceFast ---}
4146 procedure TGenDeque.InsertSpaceFast(Position, Count: Integer);
4147 var
4148 Rank : Integer;
4149 NewStart : Integer;
4150 ItemsToMove : Integer;
4151 begin
4152 if Count <= 0 then
4153 Exit;
4154
4155 if Position = 0 then
4156 begin
4157 Resize(fSize + Count);
4158
4159 NewStart := fStart - Count;
4160 if NewStart < 0 then
4161 fStart := fCapacity + NewStart
4162 else
4163 fStart := NewStart;
4164 end
4165 else if Position = fSize then
4166 begin
4167 Resize(fSize + Count);
4168 end
4169 else
4170 begin
4171 Resize(fSize + Count);
4172 Rank := IndexToRank(Position);
4173
4174 if (Rank >= fStart) and (fStart + fSize > fCapacity) then
4175 begin
4176 ItemsToMove := Rank - fStart;
4177 if ItemsToMove > 0 then
4178 RealMoveRank(fStart, fStart - Count , ItemsToMove);
4179 fStart := fStart - Count;
4180 end
4181 else
4182 begin
4183 ItemsToMove := fSize - Position - Count;
4184
4185 if ItemsToMove > 0 then
4186 RealMoveRank(Rank, Rank + Count, ItemsToMove)
4187 end;
4188 end;
4189 end;
4190
4191 {--- TGenDeque.ItemToString ---}
TGenDeque.ItemToStringnull4192 function TGenDeque.ItemToString(Index: Integer): String;
4193 begin
4194 Result := fOnItemToString(fItems[IndexToRank(Index)]);
4195 end;
4196
4197 {--- TGenDeque.RankToIndex ---}
RankToIndexnull4198 function TGenDeque.RankToIndex(Rank: Integer): Integer;
4199 begin
4200 if Rank >= fStart then
4201 Result := Rank - fStart
4202 else
4203 Result := Rank + (fCapacity - fStart);
4204 end;
4205
4206 {--- TGenDeque.IsSorted ---}
IsSortednull4207 function TGenDeque.IsSorted : Boolean;
4208 begin
4209 Result := IsSorted(fOnCompareItems);
4210 end;
4211
4212 {--- TGenDeque.IsSorted ---}
IsSortednull4213 function TGenDeque.IsSorted(Comparator: TCompareItems): Boolean;
4214 var
4215 I, Rank, PrevRank: Integer;
4216 begin
4217 Result := true;
4218
4219 if fSize > 1 then
4220 begin
4221 PrevRank := fStart;
4222 Rank := IndexToRank(1);
4223 for I := 1 to fSize - 1 do
4224 begin
4225 if Comparator(fItems[Rank], fItems[PrevRank]) < 0 then
4226 begin
4227 Result := false;
4228 Break;
4229 end;
4230 PrevRank := Rank;
4231 IncRank(Rank);
4232 end;
4233 end;
4234 end;
4235
4236 {--- TGenDeque.DefaultItemToString ---}
DefaultItemToStringnull4237 function TGenDeque.DefaultItemToString(const Item: _TItem_): String;
4238 begin
4239 Unused(@Item);
4240 RaiseMethodNotRedefined;
4241 Result := '';
4242 end;
4243
4244 {--- TGenDeque.Iterate ---}
4245 procedure TGenDeque.Iterate(Process: TProcessItem);
4246 begin
4247 Iterate(Process, 0, fSize - 1);
4248 end;
4249
4250 {--- TGenDeque.Iterate ---}
4251 procedure TGenDeque.Iterate(Process: TProcessItem; const PosFrom, PosTo: Integer);
4252 var
4253 I, Rank : Integer;
4254 begin
4255 CheckIndex(PosFrom);
4256 CheckIndex(PosTo);
4257
4258 Rank := IndexToRank(PosFrom);
4259 for I := PosFrom to PosTo do
4260 begin
4261 Process(fItems[Rank]);
4262 IncRank(Rank);
4263 end;
4264 end;
4265
4266 {--- TGenDeque.LastItem ---}
LastItemnull4267 function TGenDeque.LastItem: _TItem_;
4268 begin
4269 if fSize = 0 then
4270 RaiseContainerEmpty;
4271
4272 Result := fItems[ IndexToRank(fSize - 1) ];
4273 end;
4274
4275 {--- TGenDeque.MaxPos ---}
MaxPosnull4276 function TGenDeque.MaxPos(PosFrom, PosTo: Integer): Integer;
4277 begin
4278 Result := MaxPos(PosFrom, PosTo, fOnCompareItems);
4279 end;
4280
4281 {--- TGenDeque.MaxPos ---}
MaxPosnull4282 function TGenDeque.MaxPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
4283 var
4284 I, IRank : Integer;
4285 Max : _TItem_;
4286 begin
4287 CheckIndex(PosFrom);
4288 CheckIndex(PosTo);
4289
4290 if PosTo < PosFrom then
4291 begin
4292 I := PosFrom;
4293 PosFrom := PosTo;
4294 PosTo := I;
4295 end;
4296
4297 Max := fItems[ IndexToRank(PosFrom) ];
4298 Result := PosFrom;
4299 IRank := IndexToRank(PosFrom + 1);
4300 for I := PosFrom + 1 to PosTo do
4301 begin
4302 if Comparator(fItems[IRank], Max) > 0 then
4303 begin
4304 Result := I;
4305 Max := fItems[IRank];
4306 end;
4307 IncRank(IRank);
4308 end;
4309 end;
4310
4311 {--- TGenDeque.MaxPos ---}
MaxPosnull4312 function TGenDeque.MaxPos : Integer;
4313 begin
4314 Result := MaxPos(fOnCompareItems);
4315 end;
4316
4317 {--- TGenDeque.MaxPos ---}
MaxPosnull4318 function TGenDeque.MaxPos(Comparator: TCompareItems): Integer;
4319 begin
4320 if fSize = 0 then
4321 RaiseContainerEmpty;
4322
4323 Result := MaxPos(0, fSize - 1, Comparator);
4324 end;
4325
4326 {--- TGenDeque.Merge ---}
4327 procedure TGenDeque.Merge(Src: TGenDeque);
4328 begin
4329 Merge(Src, fOnCompareItems);
4330 end;
4331
4332 {--- TGenDeque.Merge ---}
4333 procedure TGenDeque.Merge(Src: TGenDeque; Comparator: TCompareItems);
4334 var
4335 A, B, C : Integer;
4336 ARank, BRank, CRank : Integer;
4337 begin
4338 if Src.fSize = 0 then
4339 Exit;
4340
4341 if fSize = 0 then
4342 AppendAll(Src)
4343 else if Comparator(Src.FirstItem, LastItem) >= 0 then
4344 AppendAll(Src)
4345 else if Comparator(FirstItem, Src.LastItem) >= 0 then
4346 PrependAll(Src)
4347 else
4348 begin
4349 A := fSize - 1;
4350 B := Src.fSize - 1;
4351
4352 InsertSpace(fSize, Src.fSize);
4353 C := fSize - 1;
4354
4355 ARank := IndexToRank(A);
4356 BRank := Src.IndexToRank(B);
4357 CRank := IndexToRank(C);
4358
4359 while C > 0 do
4360 begin
4361 if Comparator(fItems[ARank], Src.fItems[BRank]) > 0 then
4362 begin
4363 fItems[CRank] := fItems[ARank];
4364 Dec(A);
4365 if A < 0 then
4366 Break;
4367 DecRank(ARank);
4368 end
4369 else
4370 begin
4371 fItems[CRank] := Src.fItems[BRank];
4372 Dec(B);
4373 if B < 0 then
4374 Break;
4375 Src.DecRank(BRank);
4376 end;
4377 Dec(C);
4378 DecRank(CRank);
4379 end;
4380
4381 if (C >= 0) and (B >= 0) then
4382 begin
4383 BRank := Src.IndexToRank(B);
4384 ARank := IndexToRank(B);
4385 while B >= 0 do
4386 begin
4387 fItems[ARank] := Src.fItems[BRank];
4388 Dec(B);
4389 DecRank(BRank);
4390 DecRank(ARank);
4391 end;
4392 end;
4393
4394 end;
4395 Src.Clear;
4396 end;
4397
4398 {--- TGenDeque.MinPos ---}
MinPosnull4399 function TGenDeque.MinPos(PosFrom, PosTo: Integer): Integer;
4400 begin
4401 Result := MinPos(PosFrom, PosTo, fOnCompareItems);
4402 end;
4403
4404 {--- TGenDeque.MinPos ---}
MinPosnull4405 function TGenDeque.MinPos(PosFrom, PosTo: Integer; Comparator: TCompareItems): Integer;
4406 var
4407 I, IRank : Integer;
4408 Min : _TItem_;
4409 begin
4410 CheckIndex(PosFrom);
4411 CheckIndex(PosTo);
4412
4413 if PosTo < PosFrom then
4414 begin
4415 I := PosFrom;
4416 PosFrom := PosTo;
4417 PosTo := I;
4418 end;
4419
4420 Result := -1;
4421 Min := fItems[ IndexToRank(PosFrom) ];
4422 Result := PosFrom;
4423 IRank := IndexToRank(PosFrom + 1);
4424 for I := PosFrom + 1 to PosTo do
4425 begin
4426 if Comparator(fItems[IRank], Min) < 0 then
4427 begin
4428 Result := I;
4429 Min := fItems[IRank];
4430 end;
4431 IncRank(IRank);
4432 end;
4433 end;
4434
4435 {--- TGenDeque.MinPos ---}
MinPosnull4436 function TGenDeque.MinPos: Integer;
4437 begin
4438 Result := MinPos(fOnCompareItems);
4439 end;
4440
4441 {--- TGenDeque.MinPos ---}
MinPosnull4442 function TGenDeque.MinPos(Comparator: TCompareItems): Integer;
4443 begin
4444 if fSize = 0 then
4445 RaiseContainerEmpty;
4446
4447 Result := MinPos(0, fSize - 1, Comparator);
4448 end;
4449
4450 {--- TGenDeque.Move ---}
4451 procedure TGenDeque.Move(Src, Dst, Count: Integer);
4452 var
4453 I: Integer;
4454 begin
4455 CheckIndex(Src);
4456 CheckIndex(Dst);
4457
4458 if Src + Count > fSize then
4459 Count := fSize - Src;
4460
4461 if Dst + Count > fSize then
4462 Count := fSize - Dst;
4463
4464 if Count > 0 then
4465 begin
4466 if (Dst >= Src) and (Dst <= Src + Count - 1) then
4467 begin
4468 Dst := Dst + Count - 1;
4469 Src := Src + Count - 1;
4470
4471 Dst := IndexToRank(Dst);
4472 Src := IndexToRank(Src);
4473
4474 for I := 1 to Count do
4475 begin
4476 fItems[Dst] := fItems[Src];
4477 DecRank(Src);
4478 DecRank(Dst);
4479 end;
4480 end
4481 else
4482 begin
4483 Dst := IndexToRank(Dst);
4484 Src := IndexToRank(Src);
4485
4486 for I := 1 to Count do
4487 begin
4488 fItems[Dst] := fItems[Src];
4489 IncRank(Src);
4490 IncRank(Dst);
4491 end;
4492 end;
4493 end;
4494 end;
4495
4496 {--- TGenDeque.Prepend ---}
4497 procedure TGenDeque.Prepend(const Item: _TItem_; Count: Integer);
4498 begin
4499 Insert(0, Item, Count);
4500 end;
4501
4502 {--- TGenDeque.PrependAll ---}
4503 procedure TGenDeque.PrependAll(Src: TGenDeque);
4504 begin
4505 InsertAll(0, Src);
4506 end;
4507
4508 {--- TGenDeque.PrependRange ---}
4509 procedure TGenDeque.PrependRange(Src: TGenDeque; PosFrom, PosTo: Integer);
4510 begin
4511 InsertRange(0, Src, PosFrom, PosTo);
4512 end;
4513
4514 {--- TGenDeque.ReadFirstItem ---}
4515 procedure TGenDeque.ReadFirstItem(out Value : _TItem_);
4516 begin
4517 if fSize = 0 then
4518 RaiseContainerEmpty;
4519
4520 Value := fItems[fStart];
4521 end;
4522
4523 {--- TGenDeque.ReadItem ---}
4524 procedure TGenDeque.ReadItem(Position: Integer; out Value: _TItem_);
4525 begin
4526 CheckIndex(Position);
4527 Value := fItems[ IndexToRank(Position)];
4528 end;
4529
4530 {--- TGenDeque.ReadItemFast ---}
4531 procedure TGenDeque.ReadItemFast(Position: Integer; out Value: _TItem_);
4532 begin
4533 Value := fItems[ IndexToRank(Position)];
4534 end;
4535
4536 {--- TGenDeque.ReadLastItem ---}
4537 procedure TGenDeque.ReadLastItem(out Value : _TItem_);
4538 begin
4539 if fSize = 0 then
4540 RaiseContainerEmpty;
4541
4542 Value := fItems[ IndexToRank(fSize - 1) ];
4543 end;
4544
4545 {--- TGenDeque.Sort ---}
4546 procedure TGenDeque.Sort(PosFrom, PosTo: Integer);
4547 begin
4548 Sort(PosFrom, PosTo, fOnCompareItems);
4549 end;
4550
4551 {--- TGenDeque.Sort ---}
4552 procedure TGenDeque.Sort(PosFrom, PosTo: Integer; Comparator: TCompareItems);
4553 begin
4554 CheckIndex(PosFrom);
4555 CheckIndex(PosTo);
4556
4557 if PosFrom >= PosTo then
4558 Exit;
4559
4560 Quicksort(PosFrom, PosTo, Comparator);
4561 end;
4562
4563 {--- TGenDeque.Sort ---}
4564 procedure TGenDeque.Sort;
4565 begin
4566 Sort(fOnCompareItems);
4567 end;
4568
4569 {--- TGenDeque.Sort ---}
4570 procedure TGenDeque.Sort(Comparator: TCompareItems);
4571 begin
4572 if fSize > 1 then
4573 Sort(0, fSize - 1, Comparator);
4574 end;
4575
4576 {--- TGenDeque.RealMoveRank ---}
4577 procedure TGenDeque.RealMoveRank(Src, Dst, Count: Integer);
4578 var
4579 SrcLast, I, DstCurrent: Integer;
4580 begin
4581 if Count <= 0 then
4582 Exit;
4583
4584 SrcLast := Src + Count - 1;
4585 if (Dst >= Src) and (Dst <= SrcLast) then
4586 begin
4587 DstCurrent := Dst + Count - 1;
4588 for I := SrcLast downto Src do
4589 begin
4590 fItems[DstCurrent] := fItems[I];
4591 Dec(DstCurrent);
4592 end
4593 end
4594 else
4595 begin
4596 DstCurrent := Dst;
4597 for I := Src to SrcLast do
4598 begin
4599 fItems[DstCurrent] := fItems[I];
4600 Inc(DstCurrent);
4601 end;
4602 end;
4603 end;
4604
4605 {--- TGenDeque.RealMoveIndex ---}
4606 class procedure TGenDeque.RealMoveIndex(Src, Dst: TGenDeque;
4607 SrcFirst, DstFirst, Count: Integer);
4608 var
4609 SrcLast, I, DstCurrent: Integer;
4610 begin
4611 SrcLast := SrcFirst + Count - 1;
4612 if (Src = Dst) and ( (DstFirst >= SrcFirst) and (DstFirst <= SrcLast) ) then
4613 begin
4614 DstCurrent := DstFirst + Count - 1;
4615 for I := SrcLast downto SrcFirst do
4616 begin
4617 Dst[DstCurrent] := Src[I];
4618 Dec(DstCurrent);
4619 end
4620 end
4621 else
4622 begin
4623 DstCurrent := DstFirst;
4624 for I := SrcFirst to SrcLast do
4625 begin
4626 Dst[DstCurrent] := Src[I];
4627 Inc(DstCurrent);
4628 end;
4629 end;
4630 end;
4631
4632 {--- TGenDeque.ReduceCapacity ---}
4633 procedure TGenDeque.ReduceCapacity(ACapacity: Integer);
4634 var
4635 NewStart, ItemsAtEnd : Integer;
4636 begin
4637 if fStart + fSize >= fCapacity then
4638 begin
4639 ItemsAtEnd := fCapacity - fStart;
4640 NewStart := ACapacity - ItemsAtEnd;
4641 RealMoveRank(fStart, NewStart, ItemsAtEnd);
4642 fStart := NewStart;
4643 end;
4644
4645 SetLength(fItems, ACapacity);
4646 fCapacity := ACapacity;
4647 end;
4648
4649 {--- TGenDeque.Replace ---}
4650 procedure TGenDeque.Replace(Index, Count: Integer; const Value: _TItem_);
4651 begin
4652 CheckIndex(Index);
4653
4654 if Count > 0 then
4655 begin
4656 if Index + Count >= fSize then
4657 Count := fSize - Index;
4658 Fill(Index, Count, Value);
4659 end;
4660 end;
4661
4662 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4663 function TGenDeque.ReverseFindIndex(const Item: _TItem_): Integer;
4664 begin
4665 Result := ReverseFindIndex(Item, fOnCompareItems);
4666 end;
4667
4668 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4669 function TGenDeque.ReverseFindIndex(const Item: _TItem_; Comparator: TCompareItems): Integer;
4670 begin
4671 if fSize = 0 then
4672 Result := -1
4673 else
4674 Result := ReverseFindIndex(Item, fSize - 1, Comparator);
4675 end;
4676
4677 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4678 function TGenDeque.ReverseFindIndex(const Item: _TItem_; PosFrom: Integer): Integer;
4679 begin
4680 Result := ReverseFindIndex(Item, PosFrom, fOnCompareItems);
4681 end;
4682
4683 {--- TGenDeque.ReverseFindIndex ---}
ReverseFindIndexnull4684 function TGenDeque.ReverseFindIndex(const Item: _TItem_;
4685 PosFrom: Integer; Comparator: TCompareItems): Integer;
4686 var
4687 I, Pos: Integer;
4688 begin
4689 CheckIndex(PosFrom);
4690
4691 Result := -1;
4692 Pos := IndexToRank(PosFrom);
4693 for I := PosFrom downto 0 do
4694 begin
4695 if Comparator(fItems[Pos], Item) = 0 then
4696 begin
4697 Result := I;
4698 Break;
4699 end;
4700 DecRank(Pos);
4701 end;
4702 end;
4703
4704 {--- TGenDeque.SetCapacity ---}
4705 procedure TGenDeque.SetCapacity(ACapacity: Integer);
4706 begin
4707 if ACapacity <= fCapacity then
4708 ReduceCapacity(ACapacity)
4709 else if ACapacity > fCapacity then
4710 IncreaseCapacity(ACapacity);
4711 end;
4712
4713 {--- TGenDeque.SetOnCompareItems ---}
4714 procedure TGenDeque.SetOnCompareItems(AValue: TCompareItems);
4715 begin
4716 if AValue = nil then
4717 fOnCompareItems := @DefaultCompareItems
4718 else
4719 fOnCompareItems := AValue;
4720 end;
4721
4722 {--- TGenDeque.SetOnItemToString ---}
4723 procedure TGenDeque.SetOnItemToString(AValue: TItemToString);
4724 begin
4725 if AValue = nil then
4726 fOnItemToString := @DefaultItemToString
4727 else
4728 fOnItemToString := AValue;
4729 end;
4730
4731 {--- TGenDeque.SetItem ---}
4732 procedure TGenDeque.SetItem(Position: Integer; const Value: _TItem_);
4733 begin
4734 CheckIndex(Position);
4735 fItems[ IndexToRank(Position) ] := Value;
4736 end;
4737
4738 {--- TGenDeque.SetItemFast ---}
4739 procedure TGenDeque.SetItemFast(Position: Integer; const Value: _TItem_);
4740 begin
4741 fItems[ IndexToRank(Position) ] := Value;
4742 end;
4743
4744 {--- TGenDeque.SwapFast ---}
4745 procedure TGenDeque.SwapFast(I, J: Integer);
4746 var
4747 Temp: _TItem_;
4748 begin
4749 I := IndexToRank(I);
4750 J := IndexToRank(J);
4751
4752 Temp := fItems[I];
4753 fItems[I] := fItems[J];
4754 fItems[J] := Temp;
4755 end;
4756
4757 {===================}
4758 {=== TListCursor ===}
4759 {===================}
4760
4761 {--- TListCursor.Equals ---}
Equalsnull4762 function TListCursor.Equals(const Cursor: TListCursor): Boolean;
4763 begin
4764 Result := (fList = Cursor.fList) and (fNode = Cursor.fNode);
4765 end;
4766
4767 {--- TListCursor.HasItem ---}
HasItemnull4768 function TListCursor.HasItem: Boolean;
4769 begin
4770 Result := (fNode <> nil);
4771 end;
4772
4773 {--- TListCursor.Init ---}
4774 constructor TListCursor.Init(AList: TAbstractList; ANode: Pointer);
4775 begin
4776 fList := AList;
4777 fNode := ANode;
4778 end;
4779
4780 {--- TListCursor.IsFirst ---}
TListCursor.IsFirstnull4781 function TListCursor.IsFirst: Boolean;
4782 begin
4783 Result := fList.CursorIsFirst(Self);
4784 end;
4785
4786 {--- TListCursor.IsLast ---}
IsLastnull4787 function TListCursor.IsLast: Boolean;
4788 begin
4789 Result := fList.CursorIsLast(Self);
4790 end;
4791
4792 {--- TListCursor.IsNil ---}
TListCursor.IsNilnull4793 function TListCursor.IsNil: Boolean;
4794 begin
4795 Result := (fNode = nil);
4796 end;
4797
4798 {--- TListCursor.MoveNext ---}
4799 procedure TListCursor.MoveNext;
4800 begin
4801 fList.CursorMoveNext(Self);
4802 end;
4803
4804 {--- TListCursor.MovePrevious ---}
4805 procedure TListCursor.MovePrevious;
4806 begin
4807 fList.CursorMovePrev(Self);
4808 end;
4809
4810 {=====================}
4811 {=== TAbstractList ===}
4812 {=====================}
4813
4814 {--- TAbstractList.CheckValid ---}
4815 procedure TAbstractList.CheckValid(const Cursor: TListCursor);
4816 begin
4817 if Cursor.List <> Self then
4818 RaiseCursorDenotesWrongContainer;
4819 end;
4820
4821 {--- TAbstractList.CheckNotNil ---}
4822 procedure TAbstractList.CheckNotNil(const Cursor: TListCursor);
4823 begin
4824 CheckValid(Cursor);
4825 if Cursor.IsNil then
4826 RaiseCursorIsNil;
4827 end;
4828
4829 {================}
4830 {=== TGenList ===}
4831 {================}
4832
4833 {--- TGenList.Append ---}
4834 procedure TGenList.Append(const Item: _TItem_; Count: Integer);
4835 begin
4836 Insert(fNilCursor, Item, Count);
4837 end;
4838
4839 {--- TGenList.AppendAll ---}
4840 procedure TGenList.AppendAll(Src: TGenList);
4841 begin
4842 InsertAll(fNilCursor, Src);
4843 end;
4844
4845 {--- TGenList.AppendRange ---}
4846 procedure TGenList.AppendRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
4847 begin
4848 InsertRange(fNilCursor, Src, PosFrom, PosTo);
4849 end;
4850
4851 {--- TGenList.Clear ---}
4852 procedure TGenList.Clear;
4853 begin
4854 DeleteFirst(fSize);
4855 end;
4856
4857 {--- TGenList.DefaultCompareItems ---}
TGenList.DefaultCompareItemsnull4858 function TGenList.DefaultCompareItems(const A, B: _TItem_): Integer;
4859 begin
4860 Unused(@A);
4861 Unused(@B);
4862 RaiseMethodNotRedefined;
4863 Result := 0;
4864 end;
4865
4866 {--- TGenList.Contains ---}
Containsnull4867 function TGenList.Contains(const Item: _TItem_): Boolean;
4868 begin
4869 Result := Contains(Item, fOnCompareItems);
4870 end;
4871
4872 {--- TGenList.Contains ---}
Containsnull4873 function TGenList.Contains(const Item: _TItem_; Comparator: TCompareItems): Boolean;
4874 begin
4875 Result := not Find(Item, Comparator).IsNil;
4876 end;
4877
4878 {--- TGenList.Create ---}
4879 constructor TGenList.Create;
4880 begin
4881 inherited Create;
4882
4883 New(fHead);
4884 New(fTail);
4885 fHead^.Next := fTail;
4886 fTail^.Previous := fHead;
4887
4888 fNilCursor.Init(Self, nil);
4889
4890 SetOnCompareItems(nil);
4891 SetOnItemToString(nil);
4892 end;
4893
4894 {--- TGenList.Delete ---}
4895 procedure TGenList.Delete(var Position: TListCursor; Count: Integer);
4896 begin
4897 CheckNotNil(Position);
4898 DeleteNodesForward(PNode(Position.Node), Count);
4899 Position := fNilCursor;
4900 end;
4901
4902 {--- TGenList.DeleteFirst ---}
4903 procedure TGenList.DeleteFirst(Count: Integer);
4904 begin
4905 if (fSize > 0) and (Count > 0) then
4906 DeleteNodesForward(fHead^.Next, Count);
4907 end;
4908
4909 {--- TGenList.DeleteLast ---}
4910 procedure TGenList.DeleteLast(Count: Integer);
4911 begin
4912 if (fSize > 0) and (Count > 0) then
4913 DeleteNodesBackward(fTail^.Previous, Count);
4914 end;
4915
4916 {--- TGenList.DeleteNodesBackward ---}
4917 procedure TGenList.DeleteNodesBackward(From: PNode; Count: Integer);
4918 var
4919 Current, AfterFrom : PNode;
4920 begin
4921 AfterFrom := From^.Next;
4922
4923 Current := From;
4924 while (Count > 0) and (Current <> fHead) do
4925 begin
4926 Current^.Previous^.Next := AfterFrom;
4927 AfterFrom^.Previous := Current^.Previous;
4928
4929 Dispose(Current);
4930 Dec(fSize);
4931 Dec(Count);
4932 Current := AfterFrom^.Previous;
4933 end;
4934 end;
4935
4936 {--- TGenList.DeleteNodesBetween ---}
4937 procedure TGenList.DeleteNodesBetween(NodeFrom, NodeTo: PNode);
4938 var
4939 Current, Previous, Limit: PNode;
4940 begin
4941 Current := NodeFrom;
4942 Previous := Current^.Previous;
4943 Limit := NodeTo^.Next;
4944
4945 while Current <> Limit do
4946 begin
4947 Previous^.Next := Current^.Next;
4948 Current^.Next^.Previous := Previous;
4949
4950 Dispose(Current);
4951 Dec(fSize);
4952 Current := Previous^.Next;
4953 end;
4954 end;
4955
4956 {--- TGenList.DeleteNodesForward ---}
4957 procedure TGenList.DeleteNodesForward(From: PNode; Count: Integer);
4958 var
4959 Current, BeforeFrom : PNode;
4960 begin
4961 BeforeFrom := From^.Previous;
4962 Current := From;
4963 while (Count > 0) and (Current <> fTail) do
4964 begin
4965 BeforeFrom^.Next := Current^.Next;
4966 Current^.Next^.Previous := BeforeFrom;
4967
4968 Dispose(Current);
4969 Dec(fSize);
4970 Dec(Count);
4971 Current := BeforeFrom^.Next;
4972 end;
4973 end;
4974
4975 {--- TGenList.EnumeratorGet ---}
EnumeratorGetnull4976 function TGenList.EnumeratorGet(const Pos: TListCursor): _TItem_;
4977 begin
4978 ReadItemFast(Pos, Result);
4979 end;
4980
4981 {--- TGenList.EnumeratorNext ---}
EnumeratorNextnull4982 function TGenList.EnumeratorNext(var Pos: TListCursor): Boolean;
4983 begin
4984 if Pos.IsNil then
4985 Pos := First
4986 else
4987 Pos.MoveNext;
4988 Result := Pos.HasItem;
4989 end;
4990
4991 {--- TGenList.DeleteRange ---}
4992 procedure TGenList.DeleteRange(const PosFrom, PosTo: TListCursor);
4993 begin
4994 CheckNotNil(PosFrom);
4995 CheckNotNil(PosTo);
4996 DeleteNodesBetween(PosFrom.Node, PosTo.Node);
4997 end;
4998
4999 {--- TGenList.Destroy ---}
5000 destructor TGenList.Destroy;
5001 begin
5002 Clear;
5003 Dispose(fHead);
5004 Dispose(fTail);
5005 inherited Destroy;
5006 end;
5007
5008 {--- TGenList.Equals ---}
Equalsnull5009 function TGenList.Equals(List: TGenList; Comparator: TCompareItems): Boolean;
5010 var
5011 N1, N2 : PNode;
5012 begin
5013 if fSize <> List.fSize then
5014 begin
5015 Result := false;
5016 Exit;
5017 end;
5018
5019 Result := true;
5020 N1 := fHead^.Next;
5021 N2 := List.fHead^.Next;
5022
5023 while N1 <> fTail do
5024 begin
5025 if Comparator(N1^.Item, N2^.Item) <> 0 then
5026 begin
5027 Result := false;
5028 Break;
5029 end;
5030 N1 := N1^.Next;
5031 N2 := N2^.Next;
5032 end;
5033 end;
5034
5035 {--- TGenList.Equals ---}
Equalsnull5036 function TGenList.Equals(Obj: TObject): Boolean;
5037 begin
5038 Result := Equals(Obj, fOnCompareItems);
5039 end;
5040
5041 {--- TGenList.Equals ---}
Equalsnull5042 function TGenList.Equals(Obj: TObject; Comparator: TCompareItems): Boolean;
5043 begin
5044 if Obj = Self then
5045 Result := true
5046 else if Obj is TGenList then
5047 Result := Equals(Obj as TGenList, Comparator)
5048 else
5049 Result := false;
5050 end;
5051
5052 {--- TGenList.Find ---}
Findnull5053 function TGenList.Find(const Item: _TItem_): TListCursor;
5054 begin
5055 Result := Find(Item, fOnCompareItems);
5056 end;
5057
5058 {--- TGenList.Find ---}
Findnull5059 function TGenList.Find(const Item: _TItem_; Comparator: TCompareItems): TListCursor;
5060 begin
5061 if fSize = 0 then
5062 Result := fNilCursor
5063 else
5064 Result := Find(Item, First, Comparator);
5065 end;
5066
5067 {--- TGenList.Find ---}
Findnull5068 function TGenList.Find(const Item: _TItem_; const Position: TListCursor): TListCursor;
5069 begin
5070 Result := Find(Item, Position, fOnCompareItems);
5071 end;
5072
5073 {--- TGenList.Find ---}
Findnull5074 function TGenList.Find(const Item: _TItem_; const Position: TListCursor; Comparator: TCompareItems): TListCursor;
5075 var
5076 Node : PNode;
5077 I : _TItem_;
5078 begin
5079 CheckValid(Position);
5080
5081 if Position.IsNil then
5082 Node := fHead^.Next
5083 else
5084 Node := Position.Node;
5085
5086 while Node <> fTail do
5087 begin
5088 I := Node^.Item;
5089 if Comparator(Item, I) = 0 then
5090 Break;
5091 Node := Node^.Next;
5092 end;
5093
5094 if (Node = fTail) or (Node = fHead) then
5095 Node := nil;
5096
5097 Result.Init(Self, Node);
5098 end;
5099
5100 {--- TGenList.First ---}
TGenList.Firstnull5101 function TGenList.First: TListCursor;
5102 begin
5103 if fSize > 0 then
5104 Result.Init(Self, fHead^.Next)
5105 else
5106 Result := fNilCursor;
5107 end;
5108
5109 {--- TGenList.FirstItem ---}
FirstItemnull5110 function TGenList.FirstItem: _TItem_;
5111 begin
5112 if fSize = 0 then
5113 RaiseContainerEmpty;
5114
5115 Result := fHead^.Next^.Item;
5116 end;
5117
5118 {--- TGenList.GetCursor ---}
GetCursornull5119 function TGenList.GetCursor(Index: Integer): TListCursor;
5120 var
5121 DistanceFromHead, DistanceFromTail : LongInt;
5122 Node : PNode;
5123 begin
5124 if (Index < -1) or (Index > fSize) then
5125 Result := fNilCursor
5126 else
5127 begin
5128 DistanceFromHead := Index + 1;
5129 DistanceFromTail := fSize - Index;
5130
5131 if DistanceFromHead < DistanceFromTail then
5132 begin
5133 Node := fHead;
5134 while DistanceFromHead > 0 do
5135 begin
5136 Node := Node^.Next;
5137 Dec(DistanceFromHead);
5138 end;
5139 end
5140 else
5141 begin
5142 Node := fTail;
5143 while DistanceFromTail > 0 do
5144 begin
5145 Node := Node^.Previous;
5146 Dec(DistanceFromTail);
5147 end;
5148 end;
5149
5150 Result.Init(Self, Node);
5151 end;
5152 end;
5153
5154 {--- TGenList.GetEnumerator ---}
TGenList.GetEnumeratornull5155 function TGenList.GetEnumerator: TEnumerator;
5156 begin
5157 Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
5158 end;
5159
5160 {--- TGenList.GetItem ---}
GetItemnull5161 function TGenList.GetItem(const Position: TListCursor): _TItem_;
5162 begin
5163 CheckNotNil(Position);
5164 Result := PNode(Position.Node)^.Item;
5165 end;
5166
5167 {--- TGenList.GetItemFast ---}
GetItemFastnull5168 function TGenList.GetItemFast(const Position: TListCursor): _TItem_;
5169 begin
5170 Result := PNode(Position.Node)^.Item;
5171 end;
5172
5173 {--- TGenList.GetItemFast ---}
GetItemPtrnull5174 function TGenList.GetItemPtr(const Position: TListCursor): PItem;
5175 begin
5176 CheckNotNil(Position);
5177 Result := @PNode(Position.Node)^.Item;
5178 end;
5179
5180 {--- TGenList.GetItemFast ---}
TGenList.GetItemPtrFastnull5181 function TGenList.GetItemPtrFast(const Position: TListCursor): PItem;
5182 begin
5183 Result := @PNode(Position.Node)^.Item;
5184 end;
5185
5186 {--- TGenList.Insert ---}
5187 procedure TGenList.Insert(const Before: TListCursor; const Item: _TItem_;
5188 Count: Integer);
5189 var
5190 BeforeNode : PNode;
5191 begin
5192 CheckValid(Before);
5193
5194 if Before.HasItem then
5195 BeforeNode := PNode(Before.Node)
5196 else
5197 BeforeNode := fTail;
5198
5199 InsertItem(Item, BeforeNode, Count);
5200 end;
5201
5202 {--- TGenList.Insert ---}
5203 procedure TGenList.Insert(const Before: TListCursor; const Item: _TItem_;
5204 out Position: TListCursor; Count: Integer);
5205 var
5206 Prev, BeforeNode : PNode;
5207 begin
5208 CheckValid(Before);
5209
5210 if Before.HasItem then
5211 BeforeNode := PNode(Before.Node)
5212 else
5213 BeforeNode := fTail;
5214
5215 Prev := BeforeNode^.Previous;
5216
5217 InsertItem(Item, BeforeNode, Count);
5218
5219 Position.Init(Self, Prev^.Next);
5220 end;
5221
5222 {--- TGenList.InsertAll ---}
5223 procedure TGenList.InsertAll(const Before: TListCursor; Src: TGenList);
5224 begin
5225 if Src.fSize > 0 then
5226 InsertRange(Before, Src, Src.First, Src.Last);
5227 end;
5228
5229 {--- TGenList.InsertItem ---}
5230 procedure TGenList.InsertItem(const Item: _TItem_; Pos: PNode; Count: Integer);
5231 var
5232 Node : PNode;
5233 begin
5234 while Count > 0 do
5235 begin
5236 New(Node);
5237 Node^.Item := Item;
5238
5239 Pos^.Previous^.Next := Node;
5240
5241 Node^.Previous := Pos^.Previous;
5242 Node^.Next := Pos;
5243
5244 Pos^.Previous := Node;
5245
5246 Inc(fSize);
5247 Dec(Count);
5248 end;
5249 end;
5250
5251 {--- TGenList.InsertRange ---}
5252 procedure TGenList.InsertRange(const Before : TListCursor; Src: TGenList;
5253 const PosFrom, PosTo: TListCursor);
5254 var
5255 Copy: TGenList;
5256 Node, LastNode: PNode;
5257 begin
5258 CheckValid(Before);
5259 Src.CheckNotNil(PosFrom);
5260 Src.CheckNotNil(PosTo);
5261
5262 Copy := TGenList.Create;
5263 try
5264 Node := PNode(PosFrom.Node);
5265 LastNode := PNode(PosTo.Node)^.Next;
5266
5267 while Node <> LastNode do
5268 begin
5269 Copy.Append(Node^.Item);
5270 Node := Node^.Next;
5271 end;
5272
5273 Splice(Before, Copy);
5274 finally
5275 Copy.Free;
5276 end;
5277 end;
5278
5279 {--- TGenList.IsEmpty ---}
IsEmptynull5280 function TGenList.IsEmpty: Boolean;
5281 begin
5282 Result := (fSize = 0);
5283 end;
5284
5285 {--- TGenList.IsSorted ---}
IsSortednull5286 function TGenList.IsSorted : Boolean;
5287 begin
5288 Result := IsSorted(fOnCompareItems);
5289 end;
5290
5291 {--- TGenList.IsSorted ---}
IsSortednull5292 function TGenList.IsSorted(Comparator: TCompareItems) : Boolean;
5293 var
5294 N : PNode;
5295 I : Integer;
5296 begin
5297 Result := true;
5298
5299 N := fHead^.Next;
5300 for I := 2 to fSize do
5301 begin
5302 if Comparator(N^.Item, N^.Next^.Item) > 0 then
5303 begin
5304 Result := false;
5305 Break;
5306 end;
5307 N := N^.Next;
5308 end;
5309 end;
5310
5311 {--- TGenList.DefaultItemToString ---}
DefaultItemToStringnull5312 function TGenList.DefaultItemToString(const Item: _TItem_): String;
5313 begin
5314 Unused(@Item);
5315 RaiseMethodNotRedefined;
5316 Result := '';
5317 end;
5318
5319 {--- TGenList.Iterate ---}
5320 procedure TGenList.Iterate(Process: TProcessItem);
5321 begin
5322 if fSize > 0 then
5323 Iterate(Process, First, Last);
5324 end;
5325
5326 {--- TGenList.Iterate ---}
5327 procedure TGenList.Iterate(Process: TProcessItem; const PosFrom, PosTo: TListCursor);
5328 var
5329 Node, Limit : PNode;
5330 begin
5331 CheckNotNil(PosFrom);
5332 CheckNotNil(PosTo);
5333
5334 Node := PNode(PosFrom.Node);
5335 Limit := PNode(PosTo.Node)^.Next ;
5336
5337 while Node <> Limit do
5338 begin
5339 Process(Node^.Item);
5340 Node := Node^.Next;
5341 end;
5342 end;
5343
5344 {--- TGenList.Last ---}
Lastnull5345 function TGenList.Last: TListCursor;
5346 begin
5347 if fSize > 0 then
5348 Result.Init(Self, fTail^.Previous)
5349 else
5350 Result.Init(Self, nil);
5351 end;
5352
5353 {--- TGenList.LastItem ---}
LastItemnull5354 function TGenList.LastItem: _TItem_;
5355 begin
5356 if fSize = 0 then
5357 RaiseContainerEmpty;
5358
5359 Result := fTail^.Previous^.Item;
5360 end;
5361
5362 {--- TGenList.Merge ---}
5363 procedure TGenList.Merge(Src: TGenList);
5364 begin
5365 Merge(Src, fOnCompareItems);
5366 end;
5367
5368 {--- TGenList.Merge ---}
5369 procedure TGenList.Merge(Src: TGenList; Comparator: TCompareItems);
5370 var
5371 Node, SrcNode, N : PNode;
5372 begin
5373 if Src = Self then
5374 Exit;
5375
5376 Node := fHead^.Next;
5377 SrcNode := Src.fHead^.Next;
5378
5379 while SrcNode <> Src.fTail do
5380 begin
5381 if Node = fTail then
5382 begin
5383 SpliceNodes(fTail, SrcNode, SrcNode);
5384 fSize := fSize + Src.fSize;
5385 Src.fSize := 0;
5386 Break;
5387 end;
5388
5389 if Comparator(SrcNode^.Item, Node^.Item) < 0 then
5390 begin
5391 N := SrcNode^.Next;
5392 SpliceNodes(Node, SrcNode, SrcNode);
5393 Dec(Src.fSize);
5394 Inc(fSize);
5395 SrcNode := N;
5396 end
5397 else
5398 Node := Node^.Next;
5399 end;
5400 end;
5401
5402 {--- TGenList.Partition ---}
5403 procedure TGenList.Partition(Pivot, Back: PNode; Comparator: TCompareItems);
5404 var
5405 Node, Next : PNode;
5406 begin
5407 Node := Pivot^.Next;
5408 while Node <> Back do
5409 if Comparator(Node^.Item, Pivot^.Item) < 0 then
5410 begin
5411 Next := Node^.Next;
5412 SpliceNodes(Pivot, Node, Node);
5413 Node := Next;
5414 end
5415 else
5416 Node := Node^.Next;
5417 end;
5418
5419 {--- TGenList.Prepend ---}
5420 procedure TGenList.Prepend(const Item: _TItem_; Count: Integer);
5421 begin
5422 Insert(First, Item, Count);
5423 end;
5424
5425 {--- TGenList.PrependAll ---}
5426 procedure TGenList.PrependAll(Src: TGenList);
5427 begin
5428 InsertAll(First, Src);
5429 end;
5430
5431 {--- TGenList.PrependRange ---}
5432 procedure TGenList.PrependRange(Src: TGenList; const PosFrom, PosTo: TListCursor);
5433 begin
5434 InsertRange(First, Src, PosFrom, PosTo);
5435 end;
5436
5437 {--- TGenList.ReadFirstItem ---}
5438 procedure TGenList.ReadFirstItem(out Value : _TItem_);
5439 begin
5440 if fSize = 0 then
5441 RaiseContainerEmpty;
5442
5443 Value := fHead^.Next^.Item;
5444 end;
5445
5446 {--- TGenList.ReadItem ---}
5447 procedure TGenList.ReadItem(const Position: TListCursor; out Value: _TItem_);
5448 begin
5449 CheckNotNil(Position);
5450 Value := PNode(Position.Node)^.Item;
5451 end;
5452
5453 {--- TGenList.ReadItemFast ---}
5454 procedure TGenList.ReadItemFast(const Position: TListCursor; out Value: _TItem_);
5455 begin
5456 Value := PNode(Position.Node)^.Item;
5457 end;
5458
5459 {--- TGenList.ReadLastItem ---}
5460 procedure TGenList.ReadLastItem(out Value : _TItem_);
5461 begin
5462 if fSize = 0 then
5463 RaiseContainerEmpty;
5464
5465 Value := fTail^.Previous^.Item;
5466 end;
5467
5468 {--- TGenList.RealSort ---}
5469 procedure TGenList.RealSort(Front, Back: PNode; Comparator: TCompareItems);
5470 var
5471 Pivot : PNode;
5472 begin
5473 Pivot := Front^.Next;
5474 if Pivot <> Back then
5475 begin
5476 Partition(Pivot, Back, Comparator);
5477 RealSort(Front, Pivot, Comparator);
5478 RealSort(Pivot, Back, Comparator)
5479 end;
5480 end;
5481
5482 {--- TGenList.SetOnCompareItems ---}
5483 procedure TGenList.SetOnCompareItems(AValue: TCompareItems);
5484 begin
5485 if AValue = nil then
5486 fOnCompareItems := @DefaultCompareItems
5487 else
5488 fOnCompareItems := AValue;
5489 end;
5490
5491 {--- TGenList.SetOnItemToString ---}
5492 procedure TGenList.SetOnItemToString(AValue: TItemToString);
5493 begin
5494 if AValue = nil then
5495 fOnItemToString := @DefaultItemToString
5496 else
5497 fOnItemToString := AValue;
5498 end;
5499
5500 {--- TGenList.Replace ---}
5501 procedure TGenList.Replace(const Position: TListCursor; Count: Integer;
5502 const Value: _TItem_);
5503 var
5504 Node : PNode;
5505 begin
5506 CheckNotNil(Position);
5507
5508 Node := PNode(Position.Node);
5509 while (Count > 0) and (Node <> fTail) do
5510 begin
5511 Node^.Item := Value;
5512 Dec(Count);
5513 Node := Node^.Next;
5514 end;
5515 end;
5516
5517 {--- TGenList.Reverse ---}
5518 procedure TGenList.Reverse;
5519 begin
5520 if fSize > 1 then
5521 ReverseRange(First, Last);
5522 end;
5523
5524 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5525 function TGenList.ReverseFind(const Item: _TItem_): TListCursor;
5526 begin
5527 Result := ReverseFind(Item, fOnCompareItems);
5528 end;
5529
5530 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5531 function TGenList.ReverseFind(const Item: _TItem_; Comparator: TCompareItems): TListCursor;
5532 begin
5533 if fSize = 0 then
5534 Result := fNilCursor
5535 else
5536 Result := ReverseFind(Item, Last, Comparator);
5537 end;
5538
5539 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5540 function TGenList.ReverseFind(const Item: _TItem_; const Position: TListCursor): TListCursor;
5541 begin
5542 Result := ReverseFind(Item, Position, fOnCompareItems);
5543 end;
5544
5545 {--- TGenList.ReverseFind ---}
TGenList.ReverseFindnull5546 function TGenList.ReverseFind(const Item: _TItem_;
5547 const Position: TListCursor; Comparator: TCompareItems): TListCursor;
5548 var
5549 Node : PNode;
5550 I : _TItem_;
5551 begin
5552 CheckValid(Position);
5553
5554 if Position.IsNil then
5555 Node := fTail^.Previous
5556 else
5557 Node := PNode(Position.Node);
5558
5559 if Node = fTail then
5560 Node := Node^.Previous;
5561
5562 while Node <> fHead do
5563 begin
5564 I := Node^.Item;
5565 if Comparator(Item, I) = 0 then
5566 Break;
5567 Node := Node^.Previous;
5568 end;
5569
5570 if (Node = fTail) or (Node = fHead) then
5571 Node := nil;
5572
5573 Result.Init(Self, Node);
5574 end;
5575
5576 {--- TGenList.ReverseRange ---}
5577 procedure TGenList.ReverseRange(const PosFrom, PosTo: TListCursor);
5578 var
5579 Left, Right : PNode;
5580 Tmp : _TItem_;
5581 begin
5582 CheckNotNil(PosFrom);
5583 CheckNotNil(PosTo);
5584
5585 if not PosFrom.Equals(PosTo) then
5586 begin
5587 Left := PNode(PosFrom.Node);
5588 Right := PNode(PosTo.Node);
5589 while true do
5590 begin
5591 Tmp := Left^.Item;
5592 Left^.Item := Right^.Item;
5593 Right^.Item := Tmp;
5594
5595 Left := Left^.Next;
5596 if Left = Right then
5597 Break;
5598
5599 Right := Right^.Previous;
5600 if Left = Right then
5601 Break;
5602 end;
5603 end;
5604 end;
5605
5606 {--- TGenList.SetItem ---}
5607 procedure TGenList.SetItem(const Position: TListCursor; const Value: _TItem_);
5608 begin
5609 CheckNotNil(Position);
5610 PNode(Position.Node)^.Item := Value;
5611 end;
5612
5613 {--- TGenList.SetItemFast ---}
5614 procedure TGenList.SetItemFast(const Position: TListCursor; const Value: _TItem_);
5615 begin
5616 PNode(Position.Node)^.Item := Value;
5617 end;
5618
5619 {--- TGenList.Sort ---}
5620 procedure TGenList.Sort(const PosFrom, PosTo: TListCursor);
5621 begin
5622 Sort(PosFrom, PosTo, fOnCompareItems);
5623 end;
5624
5625 {--- TGenList.Sort ---}
5626 procedure TGenList.Sort(const PosFrom, PosTo: TListCursor; Comparator: TCompareItems);
5627 begin
5628 CheckNotNil(PosFrom);
5629 CheckNotNil(PosTo);
5630 RealSort(PNode(PosFrom.Node)^.Previous, PNode(PosTo.Node)^.Next, Comparator);
5631 end;
5632
5633 {--- TGenList.Sort ---}
5634 procedure TGenList.Sort;
5635 begin
5636 Sort(fOnCompareItems);
5637 end;
5638
5639 {--- TGenList.Sort ---}
5640 procedure TGenList.Sort(Comparator: TCompareItems);
5641 begin
5642 if fSize > 1 then
5643 Sort(First, Last, Comparator);
5644 end;
5645
5646 {--- TGenList.Splice ---}
5647 procedure TGenList.Splice(const Before: TListCursor; Src: TGenList);
5648 var
5649 Where : PNode;
5650 begin
5651 CheckValid(Before);
5652
5653 if (Self <> Src) and (Src.fSize > 0) then
5654 begin
5655 if Before.IsNil then
5656 Where := fTail
5657 else
5658 Where := PNode(Before.Node);
5659
5660 SpliceNodes(Where, Src.fHead^.Next, Src.fTail^.Previous);
5661 Inc(fSize, Src.fSize);
5662 Src.fSize:=0;
5663 end;
5664 end;
5665
5666 {--- TGenList.Splice ---}
5667 procedure TGenList.Splice(const Before: TListCursor; Src: TGenList;
5668 const SrcFrom, SrcTo: TListCursor);
5669 var
5670 Node, Where : PNode;
5671 Count : Integer = 0;
5672 begin
5673 CheckValid(Before);
5674 Src.CheckNotNil(SrcFrom);
5675 Src.CheckNotNil(SrcTo);
5676
5677 if (Src = Self) and Before.HasItem then
5678 begin
5679 if Before.Equals(SrcFrom) or Before.Equals(SrcTo) then
5680 RaiseError('cursor `Before'' is in range [SrcFrom..SrcTo]');
5681
5682 Node := PNode(SrcFrom.Node)^.Next;
5683 while Node <> PNode(SrcTo.Node) do
5684 begin
5685 if Node = PNode(Before.Node) then
5686 RaiseError('cursor `Before'' is in range [SrcFrom..SrcTo]');
5687 Node := Node^.Next;
5688 end;
5689 end
5690 else if Src <> Self then
5691 begin
5692 Node := PNode(SrcFrom.Node);
5693 while Node <> PNode(SrcTo.Node) do
5694 begin
5695 Node := Node^.Next;
5696 Inc(Count);
5697 end;
5698 Inc(Count);
5699 end;
5700
5701 if Before.HasItem then
5702 Where := PNode(Before.Node)
5703 else
5704 Where := fTail;
5705
5706 SpliceNodes(Where, PNode(SrcFrom.Node), PNode(SrcTo.Node));
5707 Inc(fSize, Count);
5708 Dec(Src.fSize, Count);
5709 end;
5710
5711 {--- TGenList.Splice ---}
5712 procedure TGenList.Splice(const Before: TListCursor; Src: TGenList;
5713 const Position: TListCursor);
5714 var
5715 Where : PNode;
5716 begin
5717 CheckValid(Before);
5718 Src.CheckNotNil(Position);
5719
5720 if not Position.Equals(Before) then
5721 begin
5722 if Before.HasItem then
5723 Where := PNode(Before.Node)
5724 else
5725 Where := fTail;
5726
5727 SpliceNodes(Where, PNode(Position.Node), PNode(Position.Node));
5728 Inc(fSize);
5729 Dec(Src.fSize);
5730 end;
5731 end;
5732
5733 {--- TGenList.SpliceNodes ---}
5734 procedure TGenList.SpliceNodes(Before, PosFrom, PosTo: PNode);
5735 begin
5736 PosFrom^.Previous^.Next := PosTo^.Next;
5737 PosTo^.Next^.Previous := PosFrom^.Previous;
5738
5739 Before^.Previous^.Next := PosFrom;
5740 PosFrom^.Previous := Before^.Previous;
5741
5742 PosTo^.Next := Before;
5743 Before^.Previous := PosTo;
5744 end;
5745
5746 {--- TGenList.CursorIsFirst ---}
CursorIsFirstnull5747 function TGenList.CursorIsFirst(const Cursor: TListCursor): Boolean;
5748 begin
5749 Result := (PNode(Cursor.Node) = (Cursor.List as TGenList).fHead^.Next) and
5750 (PNode(Cursor.Node) <> (Cursor.List as TGenList).fTail);
5751 end;
5752
5753 {--- TGenList.CursorIsLast ---}
TGenList.CursorIsLastnull5754 function TGenList.CursorIsLast(const Cursor: TListCursor): Boolean;
5755 begin
5756 Result := (PNode(Cursor.Node) = (Cursor.List as TGenList).fTail^.Previous) and
5757 (PNode(Cursor.Node) <> (Cursor.List as TGenList).fHead);
5758 end;
5759
5760 {--- TGenList.CursorMoveNext ---}
5761 procedure TGenList.CursorMoveNext(var Cursor: TListCursor);
5762 begin
5763 if Cursor.Node <> nil then
5764 begin
5765 Cursor.Node := PNode(Cursor.Node)^.Next;
5766 if PNode(Cursor.Node) = (Cursor.List as TGenList).fTail then
5767 Cursor.Node := nil;
5768 end;
5769 end;
5770
5771 {--- TGenList.CursorMovePrev ---}
5772 procedure TGenList.CursorMovePrev(var Cursor: TListCursor);
5773 begin
5774 if Cursor.Node <> nil then
5775 begin
5776 Cursor.Node := PNode(Cursor.Node)^.Previous;
5777 if PNode(Cursor.Node) = (Cursor.List as TGenList).fHead then
5778 Cursor.Node := nil;
5779 end;
5780 end;
5781
5782 {--- TGenList.Swap ---}
5783 procedure TGenList.Swap(const I, J: TListCursor);
5784 var
5785 Tmp : _TItem_;
5786 begin
5787 CheckNotNil(I);
5788 CheckNotNil(J);
5789
5790 if I.Node <> J.Node then
5791 begin
5792 Tmp := PNode(I.Node)^.Item;
5793 PNode(I.Node)^.Item := PNode(J.Node)^.Item;
5794 PNode(J.Node)^.Item := Tmp;
5795 end;
5796 end;
5797
5798 {--- TGenList.SwapLinks ---}
5799 procedure TGenList.SwapLinks(const I, J: TListCursor);
5800 var
5801 NextI : PNode;
5802 begin
5803 CheckNotNil(I);
5804 CheckNotNil(J);
5805
5806 if I.Node <> J.Node then
5807 begin
5808 NextI := PNode(I.Node)^.Next;
5809
5810 if NextI = PNode(J.Node) then
5811 SpliceNodes(PNode(I.Node), PNode(J.Node), PNode(J.Node))
5812 else
5813 begin
5814 SpliceNodes(PNode(J.Node), PNode(I.Node), PNode(I.Node));
5815 SpliceNodes(NextI, PNode(J.Node), PNode(J.Node) );
5816 end;
5817 end;
5818 end;
5819
5820 {--- TGenList.ToString ---}
TGenList.ToStringnull5821 function TGenList.ToString: String;
5822 var
5823 Node : PNode;
5824 begin
5825 Result := '(';
5826
5827 if fSize > 0 then
5828 begin
5829 Node := fHead^.Next;
5830 while Node <> fTail do
5831 begin
5832 Result := Result + fOnItemToString(Node^.Item) + ', ';
5833 Node := Node^.Next;
5834 end;
5835 SetLength(Result, Length(Result) - 2);
5836 end;
5837
5838 Result := Result + ')';
5839 end;
5840
5841 {=========================}
5842 {=== TGenPriorityQueue ===}
5843 {=========================}
5844
5845 {--- TGenPriorityQueue.Clear ---}
5846 procedure TGenPriorityQueue.Clear;
5847 begin
5848 SetLength(fItems, 1);
5849 fCapacity := 1;
5850 fSize := 0;
5851 end;
5852
5853 {--- TGenPriorityQueue.Create ---}
5854 constructor TGenPriorityQueue.Create(InitialCapacity : Integer);
5855 begin
5856 inherited Create;
5857
5858 if InitialCapacity < 1 then
5859 InitialCapacity := 1;
5860
5861 SetLength(fItems, InitialCapacity);
5862 fCapacity := InitialCapacity;
5863
5864 fSize := 0;
5865
5866 SetOnCompareItems(nil);
5867 end;
5868
5869 {--- TGenPriorityQueue.DefaultCompareItems ---}
TGenPriorityQueue.DefaultCompareItemsnull5870 function TGenPriorityQueue.DefaultCompareItems(const A, B: _TItem_): Integer;
5871 begin
5872 Unused(@A);
5873 Unused(@B);
5874 RaiseMethodNotRedefined;
5875 Result := 0;
5876 end;
5877
5878 {--- TGenPriorityQueue.IsEmpty ---}
IsEmptynull5879 function TGenPriorityQueue.IsEmpty: Boolean;
5880 begin
5881 Result := (fSize = 0);
5882 end;
5883
5884 {--- TGenPriorityQueue.Pack ---}
5885 procedure TGenPriorityQueue.Pack;
5886 begin
5887 SetLength(fItems, fSize);
5888 fCapacity := fSize;
5889 end;
5890
5891 {--- TGenPriorityQueue.Pop ---}
5892 procedure TGenPriorityQueue.Pop;
5893 begin
5894 if fSize = 0 then
5895 RaiseContainerEmpty;
5896
5897 Dec(fSize);
5898 if fSize > 0 then
5899 MoveDown(0, fItems[fSize]);
5900 end;
5901
5902 {--- TGenPriorityQueue.Push ---}
5903 procedure TGenPriorityQueue.Push(const Item: _TItem_);
5904 begin
5905 if fSize = fCapacity then
5906 Reserve(fSize + 1);
5907
5908 if fSize = 0 then
5909 fItems[0] := Item
5910 else
5911 MoveUp(fSize, Item);
5912
5913 Inc(fSize);
5914 end;
5915
5916 {--- TGenPriorityQueue.ReadTop ---}
5917 procedure TGenPriorityQueue.ReadTop(out Value: _TItem_);
5918 begin
5919 if fSize = 0 then
5920 RaiseContainerEmpty;
5921
5922 Value := fItems[0];
5923 end;
5924
5925 {--- TGenPriorityQueue.Reserve ---}
5926 procedure TGenPriorityQueue.Reserve(MinCapacity: Integer);
5927 var
5928 NewCapacity : Integer;
5929 begin
5930 if MinCapacity > fCapacity then
5931 begin
5932 if fCapacity <= 128 then
5933 NewCapacity := fCapacity * 2
5934 else
5935 NewCapacity := (fCapacity * 3) div 2;
5936
5937 if NewCapacity < MinCapacity then
5938 NewCapacity := MinCapacity;
5939
5940 SetLength(fItems, NewCapacity);
5941 fCapacity := NewCapacity;
5942 end;
5943 end;
5944
5945 {--- TGenPriorityQueue.MoveDown ---}
5946 procedure TGenPriorityQueue.MoveDown(Index: Integer; const Item: _TItem_);
5947 var
5948 Half, Child, Right : Integer;
5949 begin
5950 Half := fSize shr 1;
5951
5952 while Index < Half do
5953 begin
5954 Child := (Index shl 1) + 1;
5955
5956 Right := Child + 1;
5957
5958 if (Right < fSize) and
5959 (fOnCompareItems(fItems[Child], fItems[Right]) > 0) then
5960 Child := Right;
5961
5962 if fOnCompareItems(Item, fItems[Child]) <= 0 then
5963 Break;
5964
5965 fItems[Index] := fItems[Child];
5966 Index := Child;
5967 end;
5968 fItems[Index] := Item;
5969 end;
5970
5971 {--- TGenPriorityQueue.SetOnCompareItems ---}
5972 procedure TGenPriorityQueue.SetOnCompareItems(AValue: TCompareItems);
5973 begin
5974 if AValue = nil then
5975 fOnCompareItems := @DefaultCompareItems
5976 else
5977 fOnCompareItems := AValue;
5978 end;
5979
5980 {--- TGenPriorityQueue.MoveUp ---}
5981 procedure TGenPriorityQueue.MoveUp(Index: Integer; const Item: _TItem_);
5982 var
5983 Parent : Integer;
5984 begin
5985 while Index > 0 do
5986 begin
5987 Parent := (Index - 1) shr 1;
5988
5989 if fOnCompareItems(Item, fItems[Parent]) >= 0 then
5990 Break;
5991
5992 fItems[Index] := fItems[Parent];
5993 Index := Parent;
5994 end;
5995 fItems[Index] := Item;
5996 end;
5997
5998 {--- TGenPriorityQueue.Top ---}
Topnull5999 function TGenPriorityQueue.Top: _TItem_;
6000 begin
6001 if fSize = 0 then
6002 RaiseContainerEmpty;
6003
6004 Result := fItems[0];
6005 end;
6006
6007 {=================}
6008 {=== TGenQueue ===}
6009 {=================}
6010
6011 {--- TGenQueue.Append ---}
6012 procedure TGenQueue.Append(const Item: _TItem_);
6013 begin
6014 fData.Append(Item);
6015 end;
6016
6017 {--- TGenQueue.Clear ---}
6018 procedure TGenQueue.Clear;
6019 begin
6020 fData.Clear;
6021 end;
6022
6023 {--- TGenQueue.Create ---}
6024 constructor TGenQueue.Create;
6025 begin
6026 inherited Create;
6027 fData := _TContainer_.Create;
6028 end;
6029
6030 {--- TGenQueue.Destroy ---}
6031 destructor TGenQueue.Destroy;
6032 begin
6033 fData.Free;
6034 inherited Destroy;
6035 end;
6036
6037 {--- TGenQueue.Front ---}
TGenQueue.Frontnull6038 function TGenQueue.Front: _TItem_;
6039 begin
6040 fData.ReadFirstItem(Result);
6041 end;
6042
6043 {--- TGenQueue.GetSize ---}
GetSizenull6044 function TGenQueue.GetSize: Integer;
6045 begin
6046 Result := fData.Size;
6047 end;
6048
6049 {--- TGenQueue.IsEmpty ---}
IsEmptynull6050 function TGenQueue.IsEmpty: Boolean;
6051 begin
6052 Result := fData.Size = 0;
6053 end;
6054
6055 {--- TGenQueue.Pop ---}
6056 procedure TGenQueue.Pop;
6057 begin
6058 fData.DeleteFirst;
6059 end;
6060
6061 {--- TGenQueue.ReadFront ---}
6062 procedure TGenQueue.ReadFront(out Value: _TItem_);
6063 begin
6064 fData.ReadFirstItem(Value);
6065 end;
6066
6067 {=================}
6068 {=== TGenStack ===}
6069 {=================}
6070
6071 {--- TGenStack.Clear ---}
6072 procedure TGenStack.Clear;
6073 begin
6074 fData.Clear;
6075 end;
6076
6077 {--- TGenStack.Create ---}
6078 constructor TGenStack.Create;
6079 begin
6080 inherited Create;
6081 fData := _TContainer_.Create;
6082 end;
6083
6084 {--- TGenStack.Destroy ---}
6085 destructor TGenStack.Destroy;
6086 begin
6087 fData.Free;
6088 inherited Destroy;
6089 end;
6090
6091 {--- TGenStack.GetSize ---}
TGenStack.GetSizenull6092 function TGenStack.GetSize: Integer;
6093 begin
6094 Result := fData.Size;
6095 end;
6096
6097 {--- TGenStack.IsEmpty ---}
IsEmptynull6098 function TGenStack.IsEmpty: Boolean;
6099 begin
6100 Result := (fData.Size = 0);
6101 end;
6102
6103 {--- TGenStack.Pop ---}
6104 procedure TGenStack.Pop;
6105 begin
6106 fData.DeleteLast;
6107 end;
6108
6109 {--- TGenStack.Push ---}
6110 procedure TGenStack.Push(const Item: _TItem_);
6111 begin
6112 fData.Append(Item);
6113 end;
6114
6115 {--- TGenStack.ReadTop ---}
6116 procedure TGenStack.ReadTop(out Value : _TItem_);
6117 begin
6118 fData.ReadLastItem(Value);
6119 end;
6120
6121 {--- TGenStack.Top ---}
Topnull6122 function TGenStack.Top: _TItem_;
6123 begin
6124 fData.ReadLastItem(Result);
6125 end;
6126
6127 {======================}
6128 {=== THashMapCursor ===}
6129 {======================}
6130
6131 {--- THashMapCursor.Equals ---}
Equalsnull6132 function THashMapCursor.Equals(const Cursor: THashMapCursor): Boolean;
6133 begin
6134 Result := (fHashMap = Cursor.fHashMap) and (fBucket = Cursor.fBucket)
6135 and (fEntry = Cursor.fEntry);
6136 end;
6137
6138 {--- THashMapCursor.HasItem ---}
THashMapCursor.HasItemnull6139 function THashMapCursor.HasItem: Boolean;
6140 begin
6141 Result := (fEntry <> nil);
6142 end;
6143
6144 {--- THashMapCursor.Init ---}
6145 constructor THashMapCursor.Init(HashMap: TAbstractHashMap; BucketNum: Integer;
6146 AEntry, APrevious: Pointer);
6147 begin
6148 fHashMap := HashMap;
6149 fBucket := BucketNum;
6150 fEntry := AEntry;
6151 fPrevious := APrevious;
6152 end;
6153
6154 {--- THashMapCursor.IsFirst ---}
IsFirstnull6155 function THashMapCursor.IsFirst: Boolean;
6156 begin
6157 Result := fHashMap.CursorIsFirst(Self);
6158 end;
6159
6160 {--- THashMapCursor.IsLast ---}
IsLastnull6161 function THashMapCursor.IsLast: Boolean;
6162 begin
6163 Result := fHashMap.CursorIsLast(Self);
6164 end;
6165
6166 {--- THashMapCursor.IsNil ---}
THashMapCursor.IsNilnull6167 function THashMapCursor.IsNil: Boolean;
6168 begin
6169 Result := (fEntry = nil);
6170 end;
6171
6172 {--- THashMapCursor.MoveNext ---}
6173 procedure THashMapCursor.MoveNext;
6174 begin
6175 fHashMap.CursorMoveNext(Self);
6176 end;
6177
6178 {===================}
6179 {=== TGenHashMap ===}
6180 {===================}
6181
6182 {--- TGenHashMap.AppendBuckets ---}
6183 procedure TGenHashMap.AppendBuckets(Count: Integer);
6184 begin
6185 if Count > 0 then
6186 begin
6187 ReallocMem(fBuckets, SizeOf(PEntry) * (fBucketCount + Count));
6188 NilifyBuckets(fBucketCount, Count);
6189 fBucketCount := fBucketCount + Count;
6190 end;
6191 end;
6192
6193 {--- TGenHashMap.CollectEntries ---}
TGenHashMap.CollectEntriesnull6194 function TGenHashMap.CollectEntries: PEntry;
6195 var
6196 I : Integer;
6197 FirstEntry, LastEntry : PEntry;
6198 begin
6199 Result := nil;
6200
6201 for I := 0 to fBucketCount - 1 do
6202 begin
6203 FirstEntry := fBuckets[I];
6204
6205 if FirstEntry <> nil then
6206 begin
6207 LastEntry := FirstEntry;
6208 while LastEntry^.Next <> nil do
6209 LastEntry := LastEntry^.Next;
6210
6211 LastEntry^.Next := Result;
6212 Result := FirstEntry;
6213 end;
6214 end;
6215 end;
6216
6217 {--- TGenHashMap.Clear ---}
6218 procedure TGenHashMap.Clear;
6219 var
6220 I : Integer;
6221 begin
6222 for I := 0 to fBucketCount - 1 do
6223 begin
6224 if fBuckets[I] <> nil then
6225 begin
6226 DisposeEntries(fBuckets[I]);
6227 fBuckets[I] := nil;
6228 end;
6229 end;
6230
6231 fSize := 0;
6232 fFirstNonEmptyBucket := -1;
6233 fLastNonEmptyBucket := -1;
6234 end;
6235
6236 {--- TGenHashMap.Contains ---}
TGenHashMap.Containsnull6237 function TGenHashMap.Contains(const Key: _TKey_): Boolean;
6238 begin
6239 Result := GetEntry(Key) <> nil;
6240 end;
6241
6242 {--- TGenHashMap.Create ---}
6243 constructor TGenHashMap.Create(InitialCapacity: Integer);
6244 begin
6245 Create(InitialCapacity, DEFAULT_HASHMAP_LOAD_FACTOR)
6246 end;
6247
6248 {--- TGenHashMap.Create ---}
6249 constructor TGenHashMap.Create(InitialCapacity: Integer; MaxLoadFact: Real);
6250 var
6251 Capacity : Integer;
6252 begin
6253 inherited Create;
6254
6255 if InitialCapacity <= 0 then
6256 InitialCapacity := MIN_BUCKET_COUNT;
6257
6258 if InitialCapacity > MAX_BUCKET_COUNT then
6259 InitialCapacity := MAX_BUCKET_COUNT;
6260
6261 if MaxLoadFact <= 0 then
6262 MaxLoadFact := DEFAULT_HASHMAP_LOAD_FACTOR;
6263
6264 Capacity := MIN_BUCKET_COUNT;
6265 while Capacity < InitialCapacity do
6266 Capacity := Capacity * 2;
6267
6268 fSize := 0;
6269
6270 fMaxLoadFactor := MaxLoadFact;
6271 fThreshold := Round(Capacity * MaxLoadFact);
6272
6273 fMaxBucketCount := MAX_BUCKET_COUNT;
6274
6275 fBuckets := nil;
6276 fBucketCount := 0;
6277 AppendBuckets(Capacity);
6278
6279 fFirstNonEmptyBucket := -1;
6280 fLastNonEmptyBucket := -1;
6281
6282 fNilCursor.Init(Self, -1, nil, nil);
6283
6284 SetOnHashKey(nil);
6285 SetOnItemToString(nil);
6286 SetOnKeysEqual(nil);
6287 SetOnKeyToString(nil);
6288 end;
6289
6290 {--- TGenHashMap.Create ---}
6291 constructor TGenHashMap.Create(MaxLoadFact: Real);
6292 begin
6293 Create(MIN_BUCKET_COUNT, MaxLoadFact);
6294 end;
6295
6296 {--- TGenHashMap.Delete ---}
6297 procedure TGenHashMap.Delete(const Key: _TKey_);
6298 var
6299 Bucket: Integer;
6300 Entry, Previous : PEntry;
6301 begin
6302 Bucket := IndexFor(fOnHashKey(Key));
6303 Entry := FindEntry(Bucket, Key, Previous);
6304
6305 if Entry = nil then
6306 RaiseKeyNotInMap
6307 else
6308 DeleteEntry(Bucket, Entry, Previous);
6309 end;
6310
6311 {--- TGenHashMap.DeleteAt ---}
6312 procedure TGenHashMap.DeleteAt(const Position: THashMapCursor);
6313 begin
6314 if Position.HashMap <> Self then
6315 RaiseCursorDenotesWrongContainer;
6316
6317 if Position.IsNil then
6318 RaiseCursorIsNil;
6319
6320 DeleteEntry(Position.Bucket, Position.Entry, Position.Previous)
6321 end;
6322
6323 {--- TGenHashMap.DeleteEntry ---}
6324 procedure TGenHashMap.DeleteEntry(Bucket: Integer; Entry, Previous: PEntry);
6325 var
6326 Next : PEntry;
6327 begin
6328 Next := Entry^.Next;
6329
6330 if Previous <> nil then
6331 Previous^.Next := Next;
6332
6333 if fBuckets[Bucket] = Entry then
6334 begin
6335 fBuckets[Bucket] := Next;
6336
6337 if Next = nil then
6338 begin
6339 if Bucket = fFirstNonEmptyBucket then
6340 fFirstNonEmptyBucket := NextNonEmptyBucket(Bucket + 1);
6341
6342 if Bucket = fLastNonEmptyBucket then
6343 fLastNonEmptyBucket := PreviousNonEmptyBucket(Bucket - 1);
6344 end;
6345 end;
6346
6347 Dispose(Entry);
6348 Dec(fSize);
6349 end;
6350
6351 {--- TGenHashMap.DisposeEntries ---}
6352 procedure TGenHashMap.DisposeEntries(E: PEntry);
6353 var
6354 N: PEntry;
6355 begin
6356 while E <> nil do
6357 begin
6358 N := E^.Next;
6359 Dispose(E);
6360 E := N;
6361 end;
6362 end;
6363
6364 {--- TGenHashMap.EnumeratorGet ---}
EnumeratorGetnull6365 function TGenHashMap.EnumeratorGet(const Pos: THashMapCursor): _TItem_;
6366 begin
6367 ReadItemAt(Pos, Result);
6368 end;
6369
6370 {--- TGenHashMap.EnumeratorNext ---}
EnumeratorNextnull6371 function TGenHashMap.EnumeratorNext(var Pos: THashMapCursor): Boolean;
6372 begin
6373 if Pos.IsNil then
6374 Pos := First
6375 else
6376 Pos.MoveNext;
6377 Result := Pos.HasItem;
6378 end;
6379
6380 {--- TGenHashMap.Destroy ---}
6381 destructor TGenHashMap.Destroy;
6382 begin
6383 Clear;
6384 FreeMem(fBuckets);
6385 inherited Destroy;
6386 end;
6387
6388 {--- TGenHashMap.Exclude ---}
6389 procedure TGenHashMap.Exclude(const Key: _TKey_);
6390 var
6391 Bucket : Integer;
6392 Entry, Previous : PEntry;
6393 begin
6394 Bucket := IndexFor(fOnHashKey(Key));
6395 Entry := FindEntry(Bucket, Key, Previous);
6396
6397 if Entry <> nil then
6398 DeleteEntry(Bucket, Entry, Previous);
6399 end;
6400
6401 {--- TGenHashMap.Find ---}
Findnull6402 function TGenHashMap.Find(const Key: _TKey_): THashMapCursor;
6403 var
6404 Bucket : Integer;
6405 Entry, Previous : PEntry;
6406 begin
6407 Bucket := IndexFor(fOnHashKey(Key));
6408
6409 Entry := FindEntry(Bucket, Key, Previous);
6410
6411 Result.Init(Self, Bucket, Entry, Previous);
6412 end;
6413
6414 {--- TGenHashMap.FindEntry ---}
TGenHashMap.FindEntrynull6415 function TGenHashMap.FindEntry(Bucket: Integer; const Key: _TKey_): PEntry;
6416 begin
6417 Result := fBuckets[Bucket];
6418 while Result <> nil do
6419 begin
6420 if fOnKeysEqual(Result^.Key, Key) then
6421 Break;
6422 Result := Result^.Next;
6423 end;
6424 end;
6425
6426 {--- TGenHashMap.FindEntry ---}
TGenHashMap.FindEntrynull6427 function TGenHashMap.FindEntry(Bucket: Integer; const Key: _TKey_; out Previous: PEntry) : PEntry;
6428 begin
6429 Previous := nil;
6430 Result := fBuckets[Bucket];
6431 while Result <> nil do
6432 begin
6433 if fOnKeysEqual(Result^.Key, Key) then
6434 Break;
6435 Previous := Result;
6436 Result := Result^.Next;
6437 end;
6438 end;
6439
6440 {--- TGenHashMap.First ---}
TGenHashMap.Firstnull6441 function TGenHashMap.First: THashMapCursor;
6442 begin
6443 if fSize > 0 then
6444 Result.Init(Self, fFirstNonEmptyBucket, fBuckets[fFirstNonEmptyBucket], nil)
6445 else
6446 Result := fNilCursor;
6447 end;
6448
6449 {--- TGenHashMap.GetEnumerator ---}
GetEnumeratornull6450 function TGenHashMap.GetEnumerator: TEnumerator;
6451 begin
6452 Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
6453 end;
6454
6455 {--- TGenHashMap.GetEntry ---}
TGenHashMap.GetEntrynull6456 function TGenHashMap.GetEntry(const Key: _TKey_): PEntry;
6457 begin
6458 Result := FindEntry( IndexFor(fOnHashKey(Key)), Key);
6459 end;
6460
6461 {--- TGenHashMap.GetEntryAt ---}
TGenHashMap.GetEntryAtnull6462 function TGenHashMap.GetEntryAt(const Position: THashMapCursor): PEntry;
6463 begin
6464 if Position.HashMap <> Self then
6465 RaiseCursorDenotesWrongContainer;
6466
6467 if Position.IsNil then
6468 RaiseCursorIsNil;
6469
6470 Result := Position.Entry;
6471 end;
6472
6473 {--- TGenHashMap.GetItem ---}
GetItemnull6474 function TGenHashMap.GetItem(const Key: _TKey_): _TItem_;
6475 var
6476 Entry : PEntry;
6477 begin
6478 Entry := GetEntry(Key);
6479
6480 if Entry = nil then
6481 RaiseKeyNotInMap
6482 else
6483 Result := Entry^.Value;
6484 end;
6485
6486 {--- TGenHashMap.GetItemAt ---}
TGenHashMap.GetItemAtnull6487 function TGenHashMap.GetItemAt(const Position: THashMapCursor): _TItem_;
6488 begin
6489 Result := GetEntryAt(Position)^.Value;
6490 end;
6491
6492 {--- TGenHashMap.GetKeyAt ---}
TGenHashMap.GetKeyAtnull6493 function TGenHashMap.GetKeyAt(const Position: THashMapCursor): _TKey_;
6494 begin
6495 Result := GetEntryAt(Position)^.Key;
6496 end;
6497
6498 {--- TGenHashMap.DefaultHashKey ---}
TGenHashMap.DefaultHashKeynull6499 function TGenHashMap.DefaultHashKey(const Key: _TKey_): Integer;
6500 begin
6501 Unused(@Key);
6502 RaiseMethodNotRedefined;
6503 Result := 0;
6504 end;
6505
6506 {--- TGenHashMap.GetLoadFactor ---}
TGenHashMap.GetLoadFactornull6507 function TGenHashMap.GetLoadFactor: Real;
6508 begin
6509 Result := fSize / fBucketCount;
6510 end;
6511
6512 {--- TGenHashMap.Include ---}
6513 procedure TGenHashMap.Include(const Key: _TKey_; const Value: _TItem_);
6514 var
6515 Hash, Bucket : Integer;
6516 Entry, Previous : PEntry;
6517 begin
6518 Hash := fOnHashKey(Key);
6519 Bucket := IndexFor(Hash);
6520
6521 Entry := FindEntry(Bucket, Key, Previous);
6522 if Entry <> nil then
6523 Entry^.Value := Value
6524 else
6525 begin
6526 Entry := NewEntry(Key, Value);
6527
6528 if Previous <> nil then
6529 InsertEntry(Entry, Previous)
6530 else
6531 InsertEntry(Bucket, Entry);
6532 end;
6533 end;
6534
6535 {--- TGenHashMap.IndexFor ---}
IndexFornull6536 function TGenHashMap.IndexFor(Hash: Integer): Integer;
6537 begin
6538 Result := LongWord(Hash) and (fBucketCount - 1);
6539 end;
6540
6541 {--- TGenHashMap.InsertCollectedEntries ---}
6542 procedure TGenHashMap.InsertCollectedEntries(CollectedEntries: PEntry);
6543 var
6544 Entry, NextEntry : PEntry;
6545 Bucket : Integer;
6546 begin
6547 Entry := CollectedEntries;
6548 while Entry <> nil do
6549 begin
6550 NextEntry := Entry^.Next;
6551
6552 Bucket := IndexFor(fOnHashKey(Entry^.Key));
6553 Entry^.Next := fBuckets[Bucket];
6554 fBuckets[Bucket] := Entry;
6555
6556 Entry := NextEntry;
6557 end;
6558 end;
6559
6560 {--- TGenHashMap.Insert ---}
6561 procedure TGenHashMap.Insert(const Key: _TKey_; const Value: _TItem_);
6562 var
6563 Inserted : Boolean;
6564 begin
6565 Insert(Key, Value, Inserted);
6566 if not Inserted then
6567 RaiseKeyAlreadyInMap;
6568 end;
6569
6570 {--- TGenHashMap.Insert ---}
6571 procedure TGenHashMap.Insert(const Key: _TKey_; const Value: _TItem_; out
6572 Inserted: Boolean);
6573 var
6574 Hash, Bucket : Integer;
6575 Entry, Previous : PEntry;
6576 begin
6577 Hash := fOnHashKey(Key);
6578 Bucket := IndexFor(Hash);
6579
6580 Entry := FindEntry(Bucket, Key, Previous);
6581
6582 if Entry <> nil then
6583 Inserted := false
6584 else
6585 begin
6586 Entry := NewEntry(Key, Value);
6587
6588 if Previous <> nil then
6589 InsertEntry(Entry, Previous)
6590 else
6591 InsertEntry(Bucket, Entry);
6592
6593 Inserted := true;
6594 end;
6595 end;
6596
6597 {--- TGenHashMap.InsertEntry ---}
6598 procedure TGenHashMap.InsertEntry(Bucket: Integer; Entry: PEntry);
6599 begin
6600 Entry^.Next := fBuckets[Bucket];
6601 fBuckets[Bucket] := Entry;
6602
6603 if (fFirstNonEmptyBucket = -1) or (Bucket < fFirstNonEmptyBucket) then
6604 fFirstNonEmptyBucket := Bucket;
6605
6606 if (fLastNonEmptyBucket = -1) or (Bucket > fLastNonEmptyBucket) then
6607 fLastNonEmptyBucket := Bucket;
6608
6609 Inc(fSize);
6610 if fSize > fThreshold then
6611 Resize(2 * fBucketCount);
6612 end;
6613
6614 {--- TGenHashMap.InsertEntry ---}
6615 procedure TGenHashMap.InsertEntry(Entry, Before: PEntry);
6616 begin
6617 Before^.Next := Entry;
6618 Entry^.Next := nil;
6619
6620 Inc(fSize);
6621 if fSize > fThreshold then
6622 Resize(2 * fBucketCount);
6623 end;
6624
6625 {--- TGenHashMap.IsEmpty ---}
IsEmptynull6626 function TGenHashMap.IsEmpty: Boolean;
6627 begin
6628 Result := (fSize = 0);
6629 end;
6630
6631 {--- TGenHashMap.DefaultItemToString ---}
DefaultItemToStringnull6632 function TGenHashMap.DefaultItemToString(const Item: _TItem_): String;
6633 begin
6634 Unused(@Item);
6635 RaiseMethodNotRedefined;
6636 Result := '';
6637 end;
6638
6639 {--- TGenHashMap.DefaultKeysEqual ---}
DefaultKeysEqualnull6640 function TGenHashMap.DefaultKeysEqual(const A, B: _TKey_): Boolean;
6641 begin
6642 Unused(@A);
6643 Unused(@B);
6644 RaiseMethodNotRedefined;
6645 Result := false;
6646 end;
6647
6648 {--- TGenHashMap.DefaultKeyToString ---}
DefaultKeyToStringnull6649 function TGenHashMap.DefaultKeyToString(const Key: _TKey_): String;
6650 begin
6651 Unused(@Key);
6652 RaiseMethodNotRedefined;
6653 Result := '';
6654 end;
6655
6656 {--- TGenHashMap.NextNonEmptyBucket ---}
NextNonEmptyBucketnull6657 function TGenHashMap.NextNonEmptyBucket(Bucket: Integer): Integer;
6658 var
6659 I : Integer;
6660 begin
6661 Result := -1;
6662 for I := Bucket to fBucketCount - 1 do
6663 if fBuckets[I] <> nil then
6664 begin
6665 Result := I;
6666 Exit;
6667 end;
6668 end;
6669
6670 {--- TGenHashMap.NewEntry ---}
NewEntrynull6671 function TGenHashMap.NewEntry(const Key: _TKey_; const Value: _TItem_) : PEntry;
6672 begin
6673 New(Result);
6674 Result^.Key := Key;
6675 Result^.Value := Value;
6676 end;
6677
6678 {--- TGenHashMap.NilifyBuckets ---}
6679 procedure TGenHashMap.NilifyBuckets(BucketFrom, Count: Integer);
6680 var
6681 I : Integer;
6682 begin
6683 for I := BucketFrom to BucketFrom + Count - 1 do
6684 fBuckets[I] := nil;
6685 end;
6686
6687 {--- TGenHashMap.PreviousNonEmptyBucket ---}
TGenHashMap.PreviousNonEmptyBucketnull6688 function TGenHashMap.PreviousNonEmptyBucket(Bucket: Integer): Integer;
6689 var
6690 I : Integer;
6691 begin
6692 Result := -1;
6693 for I := Bucket downto 0 do
6694 if fBuckets[I] <> nil then
6695 begin
6696 Result := I;
6697 Break;
6698 end;
6699 end;
6700
6701 {--- TGenHashMap.ReadItem ---}
6702 procedure TGenHashMap.ReadItem(const Key: _TKey_; out Value: _TItem_);
6703 var
6704 Entry : PEntry;
6705 begin
6706 Entry := GetEntry(Key);
6707
6708 if Entry = nil then
6709 RaiseKeyNotInMap
6710 else
6711 Value := Entry^.Value;
6712 end;
6713
6714 {--- TGenHashMap.ReadItemAt ---}
6715 procedure TGenHashMap.ReadItemAt(const Position: THashMapCursor; out Value: _TItem_);
6716 begin
6717 Value := GetEntryAt(Position)^.Value;
6718 end;
6719
6720 {--- TGenHashMap.ReadKeyAt ---}
6721 procedure TGenHashMap.ReadKeyAt(const Position : THashMapCursor; out Key: _TKey_);
6722 begin
6723 Key := GetEntryAt(Position)^.Key;
6724 end;
6725
6726 {--- TGenHashMap.Replace ---}
6727 procedure TGenHashMap.Replace(const Key: _TKey_; const Value: _TItem_);
6728 var
6729 Bucket : Integer;
6730 Entry : PEntry;
6731 begin
6732 Bucket := IndexFor(fOnHashKey(Key));
6733
6734 Entry := FindEntry(Bucket, Key);
6735
6736 if Entry = nil then
6737 RaiseKeyNotInMap;
6738
6739 Entry^.Value := Value;
6740 end;
6741
6742 {--- TGenHashMap.Resize ---}
6743 procedure TGenHashMap.Resize(NewCapacity: Integer);
6744 var
6745 CollectedEntries : PEntry;
6746 OldCapacity : Integer;
6747 begin
6748 OldCapacity := fBucketCount;
6749
6750 if OldCapacity = MAX_BUCKET_COUNT then
6751 begin
6752 fThreshold := High(Integer);
6753 Exit;
6754 end;
6755
6756 { Collect all entries }
6757 CollectedEntries := CollectEntries;
6758
6759 if (fFirstNonEmptyBucket >= 0) and (fLastNonEmptyBucket >= 0) then
6760 NilifyBuckets(fFirstNonEmptyBucket, fLastNonEmptyBucket - fFirstNonEmptyBucket + 1)
6761 else
6762 NilifyBuckets(0, fBucketCount);
6763
6764 { Create necessary buckets }
6765 AppendBuckets(NewCapacity - OldCapacity);
6766 fThreshold := Round(NewCapacity * fMaxLoadFactor);
6767
6768 { Re-insert collected entries }
6769 InsertCollectedEntries(CollectedEntries);
6770
6771 fFirstNonEmptyBucket := NextNonEmptyBucket(0);
6772 fLastNonEmptyBucket := PreviousNonEmptyBucket(fBucketCount - 1);
6773 end;
6774
6775 {--- TGenHashMap.SetOnHashKey ---}
6776 procedure TGenHashMap.SetOnHashKey(AValue: THashKey);
6777 begin
6778 if AValue = nil then
6779 fOnHashKey := @DefaultHashKey
6780 else
6781 fOnHashKey:=AValue;
6782 end;
6783
6784 {--- TGenHashMap.SetOnItemToString ---}
6785 procedure TGenHashMap.SetOnItemToString(AValue: TItemToString);
6786 begin
6787 if AValue = nil then
6788 fOnItemToString := @DefaultItemToString
6789 else
6790 fOnItemToString := AValue;
6791 end;
6792
6793 {--- TGenHashMap.SetOnKeysEqual ---}
6794 procedure TGenHashMap.SetOnKeysEqual(AValue: TKeysEqual);
6795 begin
6796 if AValue = nil then
6797 fOnKeysEqual := @DefaultKeysEqual
6798 else
6799 fOnKeysEqual := AValue;
6800 end;
6801
6802 {--- TGenHashMap.SetOnKeyToString ---}
6803 procedure TGenHashMap.SetOnKeyToString(AValue: TKeyToString);
6804 begin
6805 if AValue = nil then
6806 fOnKeyToString := @DefaultKeyToString
6807 else
6808 fOnKeyToString:=AValue;
6809 end;
6810
6811 {--- TGenHashMap.CursorIsFirst ---}
CursorIsFirstnull6812 function TGenHashMap.CursorIsFirst(const Cursor: THashMapCursor): Boolean;
6813 var
6814 Map : TGenHashMap;
6815 begin
6816 Map := Cursor.HashMap as TGenHashMap;
6817 Result := false;
6818 if Cursor.Bucket = Map.fFirstNonEmptyBucket then
6819 Result := Map.fBuckets[Map.fFirstNonEmptyBucket] = Cursor.Entry;
6820 end;
6821
6822 {--- TGenHashMap.CursorIsLast ---}
TGenHashMap.CursorIsLastnull6823 function TGenHashMap.CursorIsLast(const Cursor: THashMapCursor): Boolean;
6824 var
6825 Map : TGenHashMap;
6826 Entry : PEntry;
6827 begin
6828 Map := Cursor.HashMap as TGenHashMap;
6829 Entry := PEntry(Cursor.Entry);
6830 Result := (Cursor.Bucket = Map.fLastNonEmptyBucket) and (Entry^.Next = nil);
6831 end;
6832
6833 {--- TGenHashMap.CursorMoveNext ---}
6834 procedure TGenHashMap.CursorMoveNext(const Cursor: THashMapCursor);
6835 var
6836 Map : TGenHashMap;
6837 begin
6838 if Cursor.Bucket <> -1 then
6839 begin
6840 Map := Cursor.HashMap as TGenHashMap;
6841
6842 Cursor.Previous := Cursor.Entry;
6843 Cursor.Entry := PEntry(Cursor.Entry)^.Next;
6844 if Cursor.Entry = nil then
6845 begin
6846 Cursor.Bucket := Map.NextNonEmptyBucket(Cursor.Bucket + 1);
6847 Cursor.Previous := nil;
6848 if Cursor.Bucket >= 0 then
6849 Cursor.Entry := Map.fBuckets[Cursor.Bucket];
6850 end;
6851 end;
6852 end;
6853
6854 {--- TGenHashMap.SetItemAt ---}
6855 procedure TGenHashMap.SetItemAt(const Position: THashMapCursor; AValue: _TItem_);
6856 begin
6857 GetEntryAt(Position)^.Value := AValue;
6858 end;
6859
6860 {--- TGenHashMap.ToString ---}
TGenHashMap.ToStringnull6861 function TGenHashMap.ToString: String;
6862 var
6863 Bucket, LastBucket, I : Integer;
6864 Entry : PEntry;
6865 begin
6866 Result := '{';
6867
6868 I := 1;
6869 LastBucket := fBucketCount - 1;
6870 for Bucket := 0 to LastBucket do
6871 begin
6872 Entry := fBuckets[Bucket];
6873
6874 while Entry <> nil do
6875 begin
6876 Result := Result + '(' + fOnKeyToString(Entry^.Key) + '=>' +
6877 fOnItemToString(Entry^.Value) + ')';
6878
6879 if I < fSize then
6880 Result := Result + ', ';
6881
6882 Inc(I);
6883 Entry := Entry^.Next;
6884 end;
6885 end;
6886
6887 Result := Result + '}';
6888 end;
6889
6890 {======================}
6891 {=== THashSetCursor ===}
6892 {======================}
6893
6894 {--- THashSetCursor.Equals ---}
Equalsnull6895 function THashSetCursor.Equals(const Cursor: THashSetCursor): Boolean;
6896 begin
6897 Result := fPos.Equals(Cursor.fPos)
6898 end;
6899
6900 {--- THashSetCursor.HasItem ---}
HasItemnull6901 function THashSetCursor.HasItem: Boolean;
6902 begin
6903 Result := fPos.HasItem;
6904 end;
6905
6906 {--- THashSetCursor.Init ---}
6907 constructor THashSetCursor.Init(HashSet: TAbstractHashSet;
6908 const APos: THashMapCursor);
6909 begin
6910 fHashSet := HashSet;
6911 fPos := APos;
6912 end;
6913
6914 {--- THashSetCursor.IsFirst ---}
THashSetCursor.IsFirstnull6915 function THashSetCursor.IsFirst: Boolean;
6916 begin
6917 Result := fPos.IsFirst;
6918 end;
6919
6920 {--- THashSetCursor.IsLast ---}
IsLastnull6921 function THashSetCursor.IsLast: Boolean;
6922 begin
6923 Result := fPos.IsLast;
6924 end;
6925
6926 {--- THashSetCursor.IsNil ---}
THashSetCursor.IsNilnull6927 function THashSetCursor.IsNil: Boolean;
6928 begin
6929 Result := fPos.IsNil;
6930 end;
6931
6932 {--- THashSetCursor.MoveNext ---}
6933 procedure THashSetCursor.MoveNext;
6934 begin
6935 fPos.MoveNext;
6936 end;
6937
6938 {===================}
6939 {=== TGenHashSet ===}
6940 {===================}
6941
6942 {--- TGenHashSet.Clear ---}
6943 procedure TGenHashSet.Clear;
6944 begin
6945 fMap.Clear;
6946 end;
6947
6948 {--- TGenHashSet.Contains ---}
Containsnull6949 function TGenHashSet.Contains(const Item: _TItem_): Boolean;
6950 begin
6951 Result := fMap.Contains(Item);
6952 end;
6953
6954 {--- TGenHashSet.Create ---}
6955 constructor TGenHashSet.Create(InitialCapacity: Integer);
6956 begin
6957 Create(InitialCapacity, 0.75);
6958 end;
6959
6960 {--- TGenHashSet.Create ---}
6961 constructor TGenHashSet.Create(InitialCapacity: Integer; LoadFact: Real);
6962 begin
6963 fMap := TMap.Create(InitialCapacity, LoadFact);
6964 fNilCursor.Init(Self, fMap.NilCursor);
6965 SetOnHashItem(nil);
6966 SetOnItemToString(nil);
6967 SetOnItemsEqual(nil);
6968 end;
6969
6970 {--- TGenHashSet.Create ---}
6971 constructor TGenHashSet.Create(LoadFact: Real);
6972 begin
6973 Create(16, LoadFact);
6974 end;
6975
6976 {--- TGenHashSet.Delete ---}
6977 procedure TGenHashSet.Delete(const Item: _TItem_);
6978 var
6979 C : THashMapCursor;
6980 begin
6981 C := fMap.Find(Item);
6982
6983 if C.IsNil then
6984 RaiseItemNotInSet;
6985
6986 fMap.DeleteAt(C);
6987 end;
6988
6989 {--- TGenHashSet.DeleteAt ---}
6990 procedure TGenHashSet.DeleteAt(const Position: THashSetCursor);
6991 begin
6992 fMap.DeleteAt(Position.Pos);
6993 end;
6994
6995 {--- TGenHashSet.Destroy ---}
6996 destructor TGenHashSet.Destroy;
6997 begin
6998 fMap.Free;
6999 inherited Destroy;
7000 end;
7001
7002 {--- TGenHashSet.Difference ---}
7003 procedure TGenHashSet.Difference(Left, Right: TGenHashSet);
7004 begin
7005 if Left <> Self then
7006 begin
7007 Clear;
7008 IncludeAll(Left);
7009 end;
7010
7011 if Left <> Right then
7012 ExcludeAll(Right)
7013 else
7014 Clear;
7015 end;
7016
7017 {--- TGenHashSet.DefaultItemsEqual ---}
DefaultItemsEqualnull7018 function TGenHashSet.DefaultItemsEqual(const A, B: _TItem_): Boolean;
7019 begin
7020 Unused(@A);
7021 Unused(@B);
7022 RaiseMethodNotRedefined;
7023 Result := true;
7024 end;
7025
7026 {--- TGenHashSet.DefaultItemToString ---}
DefaultItemToStringnull7027 function TGenHashSet.DefaultItemToString(const Item: _TItem_): String;
7028 begin
7029 Unused(@Item);
7030 RaiseMethodNotRedefined;
7031 Result := '';
7032 end;
7033
7034 {--- TGenHashSet.DefaultHashItem ---}
DefaultHashItemnull7035 function TGenHashSet.DefaultHashItem(const Item: _TItem_): Integer;
7036 begin
7037 Unused(@Item);
7038 RaiseMethodNotRedefined;
7039 Result := 0;
7040 end;
7041
7042 {--- TGenHashSet.EnumeratorGet ---}
EnumeratorGetnull7043 function TGenHashSet.EnumeratorGet(const Pos: THashSetCursor): _TItem_;
7044 begin
7045 ReadItemAt(Pos, Result);
7046 end;
7047
7048 {--- TGenHashSet.EnumeratorNext ---}
EnumeratorNextnull7049 function TGenHashSet.EnumeratorNext(var Pos: THashSetCursor): Boolean;
7050 begin
7051 if Pos.IsNil then
7052 Pos := First
7053 else
7054 Pos.MoveNext;
7055 Result := Pos.HasItem;
7056 end;
7057
7058 {--- TGenHashSet.ExchangeContent ---}
7059 procedure TGenHashSet.ExchangeContent(ASet: TGenHashSet);
7060 var
7061 Tmp : TMap;
7062 begin
7063 Tmp := fMap;
7064 fMap := ASet.fMap;
7065 ASet.fMap := Tmp;
7066 end;
7067
7068 {--- TGenHashSet.GetItemToString ---}
GetItemToStringnull7069 function TGenHashSet.GetItemToString: TItemToString;
7070 begin
7071 Result := fMap.OnKeyToString;
7072 end;
7073
7074 {--- TGenHashSet.GetOnHashItem ---}
TGenHashSet.GetOnHashItemnull7075 function TGenHashSet.GetOnHashItem: THashItem;
7076 begin
7077 Result := fMap.OnHashKey;
7078 end;
7079
7080 {--- TGenHashSet.GetOnItemsEqual ---}
GetOnItemsEqualnull7081 function TGenHashSet.GetOnItemsEqual: TItemEquals;
7082 begin
7083 Result := fMap.OnKeysEqual;
7084 end;
7085
7086 {--- TGenHashSet.Exclude ---}
7087 procedure TGenHashSet.Exclude(const Item: _TItem_);
7088 begin
7089 fMap.Exclude(Item);
7090 end;
7091
7092 {--- TGenHashSet.ExcludeAll ---}
7093 procedure TGenHashSet.ExcludeAll(ASet: TGenHashSet);
7094 var
7095 C: THashMapCursor;
7096 I: Integer;
7097 begin
7098 if ASet.GetSize > 0 then
7099 begin
7100 C := ASet.fMap.First;
7101 for I := 1 to ASet.GetSize do
7102 begin
7103 Exclude(ASet.fMap.Keys[C]);
7104 C.MoveNext;
7105 end;
7106 end;
7107 end;
7108
7109 {--- TGenHashSet.First ---}
TGenHashSet.Firstnull7110 function TGenHashSet.First: THashSetCursor;
7111 begin
7112 Result.Init(Self, fMap.First);
7113 end;
7114
7115 {--- TGenHashSet.GetEnumerator ---}
GetEnumeratornull7116 function TGenHashSet.GetEnumerator: TEnumerator;
7117 begin
7118 Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
7119 end;
7120
7121 {--- TGenHashSet.GetItemAt ---}
GetItemAtnull7122 function TGenHashSet.GetItemAt(const Position: THashSetCursor): _TItem_;
7123 begin
7124 fMap.ReadKeyAt(Position.Pos, Result);
7125 end;
7126
7127 {--- TGenHashSet.GetSize ---}
GetSizenull7128 function TGenHashSet.GetSize: Integer;
7129 begin
7130 Result := fMap.Size;
7131 end;
7132
7133 {--- TGenHashSet.SetOnHashItem ---}
7134 procedure TGenHashSet.SetOnHashItem(AValue: THashItem);
7135 begin
7136 if AValue = nil then
7137 fMap.OnHashKey := @DefaultHashItem
7138 else
7139 fMap.OnHashKey := AValue;
7140 end;
7141
7142 {--- TGenHashSet.SetOnItemsEqual ---}
7143 procedure TGenHashSet.SetOnItemsEqual(AValue: TItemEquals);
7144 begin
7145 if AValue = nil then
7146 fMap.OnKeysEqual := @DefaultItemsEqual
7147 else
7148 fMap.OnKeysEqual := AValue;
7149 end;
7150
7151 {--- TGenHashSet.SetOnItemToString ---}
7152 procedure TGenHashSet.SetOnItemToString(AValue: TItemToString);
7153 begin
7154 if AValue = nil then
7155 fMap.OnKeyToString := @DefaultItemToString
7156 else
7157 fMap.OnKeyToString := AValue;
7158 end;
7159
7160 {--- TGenHashSet.Include ---}
7161 procedure TGenHashSet.Include(const Item: _TItem_);
7162 begin
7163 fMap.Include(Item, 0);
7164 end;
7165
7166 {--- TGenHashSet.IncludeAll ---}
7167 procedure TGenHashSet.IncludeAll(ASet: TGenHashSet);
7168 var
7169 C: THashMapCursor;
7170 I: Integer;
7171 begin
7172 if ASet.GetSize > 0 then
7173 begin
7174 C := ASet.fMap.First;
7175 for I := 1 to ASet.GetSize do
7176 begin
7177 Include(ASet.fMap.Keys[C]);
7178 C.MoveNext;
7179 end;
7180 end;
7181 end;
7182
7183 {--- TGenHashSet.Insert ---}
7184 procedure TGenHashSet.Insert(const Item: _TItem_);
7185 var
7186 Inserted : Boolean;
7187 begin
7188 Insert(Item, Inserted);
7189 if not Inserted then
7190 RaiseItemAlreadyInSet;
7191 end;
7192
7193 {--- TGenHashSet.Insert ---}
7194 procedure TGenHashSet.Insert(const Item: _TItem_; out Inserted: Boolean);
7195 begin
7196 fMap.Insert(Item, 0, Inserted);
7197 end;
7198
7199 {--- TGenHashSet.Intersection ---}
7200 procedure TGenHashSet.Intersection(Left, Right: TGenHashSet);
7201 var
7202 Inter, Tmp : TGenHashSet;
7203 I : Integer;
7204 C : THashMapCursor;
7205 Item : _TItem_;
7206 begin
7207 if (Left.GetSize = 0) or (Right.GetSize = 0) then
7208 Clear
7209 else
7210 begin
7211 Inter := TGenHashSet.Create;
7212 Inter.OnHashItem := OnHashItem;
7213 Inter.OnItemsEqual := OnItemsEqual;
7214 Inter.OnItemToString := OnItemToString;
7215
7216 try
7217 if Left.GetSize < Right.GetSize then
7218 begin
7219 Tmp := Left;
7220 Left := Right;
7221 Right := Tmp;
7222 end;
7223
7224 C := Left.fMap.First;
7225 for I := 1 to Left.GetSize do
7226 begin
7227 Item := Left.fMap.Keys[C];
7228 if Right.fMap.Contains(Item) then
7229 Inter.Include(Item);
7230 C.MoveNext;
7231 end;
7232
7233 ExchangeContent(Inter);
7234 finally
7235 Inter.Free;
7236 end;
7237 end;
7238 end;
7239
7240 {--- TGenHashSet.IsEmpty ---}
IsEmptynull7241 function TGenHashSet.IsEmpty: Boolean;
7242 begin
7243 Result := (fMap.Size = 0);
7244 end;
7245
7246 {--- TGenHashSet.IsSubset ---}
TGenHashSet.IsSubsetnull7247 function TGenHashSet.IsSubset(OfSet: TGenHashSet): Boolean;
7248 var
7249 I : Integer;
7250 C : THashMapCursor;
7251 begin
7252 if GetSize > 0 then
7253 begin
7254 C := fMap.First;
7255 for I := 1 to GetSize do
7256 begin
7257 if not OfSet.fMap.Contains(fMap.Keys[C]) then
7258 begin
7259 Result := false;
7260 Exit;
7261 end;
7262 C.MoveNext;
7263 end;
7264 end;
7265 Result := true;
7266 end;
7267
7268 {--- TGenHashSet.Overlaps ---}
Overlapsnull7269 function TGenHashSet.Overlaps(ASet: TGenHashSet): Boolean;
7270 var
7271 I : Integer;
7272 C : THashMapCursor;
7273 begin
7274 Result := false;
7275 if GetSize > 0 then
7276 begin
7277 C := fMap.First;
7278 for I := 1 to GetSize do
7279 begin
7280 if ASet.fMap.Contains(fMap.Keys[C]) then
7281 begin
7282 Result := true;
7283 Break;
7284 end;
7285 C.MoveNext;
7286 end;
7287 end;
7288 end;
7289
7290 {--- TGenHashSet.ReadItemAt ---}
7291 procedure TGenHashSet.ReadItemAt(const Position: THashSetCursor;
7292 out Value: _TItem_);
7293 begin
7294 fMap.ReadKeyAt(Position.Pos, Value);
7295 end;
7296
7297 {--- TGenHashSet.SymmetricDifference ---}
7298 procedure TGenHashSet.SymmetricDifference(Left, Right: TGenHashSet);
7299 var
7300 Inter: TGenHashSet;
7301 begin
7302 Inter := TGenHashSet.Create;
7303 Inter.OnHashItem := OnHashItem;
7304 Inter.OnItemsEqual := OnItemsEqual;
7305 Inter.OnItemToString := OnItemToString;
7306
7307 try
7308 Inter.Intersection(Left, Right);
7309
7310 Union(Left, Right);
7311 Difference(Self, Inter);
7312 finally
7313 Inter.Free;
7314 end;
7315 end;
7316
7317 {--- TGenHashSet.ToString ---}
TGenHashSet.ToStringnull7318 function TGenHashSet.ToString: String;
7319 var
7320 C : THashMapCursor;
7321 begin
7322 Result := '{';
7323 if GetSize > 0 then
7324 begin
7325 C := fMap.First;
7326 while C.HasItem do
7327 begin
7328 Result := Result + fMap.OnKeyToString(fMap.Keys[C]);
7329 if not C.IsLast then
7330 Result := Result + '; ';
7331 C.MoveNext;
7332 end;
7333 end;
7334 Result := Result + '}';
7335 end;
7336
7337 {--- TGenHashSet.Union ---}
7338 procedure TGenHashSet.Union(Left, Right: TGenHashSet);
7339 begin
7340 if Left <> Self then
7341 begin
7342 Clear;
7343 IncludeAll(Left);
7344 end;
7345
7346 if Left <> Right then
7347 IncludeAll(Right);
7348 end;
7349
7350 {======================}
7351 {=== TTreeMapCursor ===}
7352 {======================}
7353
7354 {--- TTreeMapCursor.Equals ---}
Equalsnull7355 function TTreeMapCursor.Equals(const Cursor: TTreeMapCursor): Boolean;
7356 begin
7357 Result := (fTreeMap = Cursor.fTreeMap) and (fEntry = Cursor.fEntry);
7358 end;
7359
7360 {--- TTreeMapCursor.HasItem ---}
HasItemnull7361 function TTreeMapCursor.HasItem: Boolean;
7362 begin
7363 Result := (fEntry <> nil);
7364 end;
7365
7366 {--- TTreeMapCursor.Init ---}
7367 constructor TTreeMapCursor.Init(Map: TAbstractTreeMap; AnEntry: Pointer);
7368 begin
7369 fTreeMap := Map;
7370 fEntry := AnEntry;
7371 end;
7372
7373 {--- TTreeMapCursor.IsFirst ---}
IsFirstnull7374 function TTreeMapCursor.IsFirst: Boolean;
7375 begin
7376 Result := fTreeMap.CursorIsFirst(Self);
7377 end;
7378
7379 {--- TTreeMapCursor.IsLast ---}
IsLastnull7380 function TTreeMapCursor.IsLast: Boolean;
7381 begin
7382 Result := fTreeMap.CursorIsLast(Self);
7383 end;
7384
7385 {--- TTreeMapCursor.IsNil ---}
TTreeMapCursor.IsNilnull7386 function TTreeMapCursor.IsNil: Boolean;
7387 begin
7388 Result := (fEntry = nil);
7389 end;
7390
7391 {--- TTreeMapCursor.MoveNext ---}
7392 procedure TTreeMapCursor.MoveNext;
7393 begin
7394 fTreeMap.CursorMoveNext(Self);
7395 end;
7396
7397 {--- TTreeMapCursor.MovePrevious ---}
7398 procedure TTreeMapCursor.MovePrevious;
7399 begin
7400 fTreeMap.CursorMovePrev(Self);
7401 end;
7402
7403 {===================}
7404 {=== TGenTreeMap ===}
7405 {===================}
7406
7407 {--- TGenTreeMap.Ceiling ---}
TGenTreeMap.Ceilingnull7408 function TGenTreeMap.Ceiling(const Key: _TKey_): TTreeMapCursor;
7409 begin
7410 Result.Init(Self, GetCeilingEntry(Key));
7411 end;
7412
7413 {--- TGenTreeMap.Clear ---}
7414 procedure TGenTreeMap.Clear;
7415 begin
7416 DeleteTree(fRoot);
7417 fRoot := nil;
7418 end;
7419
7420 {--- TGenTreeMap.ColorOf ---}
TGenTreeMap.ColorOfnull7421 function TGenTreeMap.ColorOf(E: PEntry): TColor;
7422 begin
7423 if E = nil then
7424 Result := cBlack
7425 else
7426 Result := E^.Color;
7427 end;
7428
7429 {--- TGenTreeMap.Contains ---}
Containsnull7430 function TGenTreeMap.Contains(const Key: _TKey_): Boolean;
7431 begin
7432 Result := GetEntry(Key) <> nil;
7433 end;
7434
7435 {--- TGenTreeMap.Create ---}
7436 constructor TGenTreeMap.Create;
7437 begin
7438 inherited Create;
7439 fSize := 0;
7440 fRoot := nil;
7441 fNilCursor.Init(Self, nil);
7442 SetOnCompareKeys(nil);
7443 SetOnItemToString(nil);
7444 SetOnKeyToString(nil);
7445 end;
7446
7447 {--- TGenTreeMap.DefaultCompareKeys ---}
DefaultCompareKeysnull7448 function TGenTreeMap.DefaultCompareKeys(const A, B: _TKey_): Integer;
7449 begin
7450 Unused(@A);
7451 Unused(@B);
7452 RaiseMethodNotRedefined;
7453 Result := 0;
7454 end;
7455
7456 {--- TGenTreeMap.DefaultItemToString ---}
DefaultItemToStringnull7457 function TGenTreeMap.DefaultItemToString(const Item: _TItem_): String;
7458 begin
7459 Unused(@Item);
7460 RaiseMethodNotRedefined;
7461 Result := '';
7462 end;
7463
7464 {--- TGenTreeMap.DefaultKeyToString ---}
TGenTreeMap.DefaultKeyToStringnull7465 function TGenTreeMap.DefaultKeyToString(const Key: _TKey_): String;
7466 begin
7467 Unused(@Key);
7468 RaiseMethodNotRedefined;
7469 Result := '';
7470 end;
7471
7472 {--- TGenTreeMap.Delete ---}
7473 procedure TGenTreeMap.Delete(const Key: _TKey_);
7474 var
7475 Entry : PEntry;
7476 begin
7477 Entry := GetEntry(Key);
7478 if Entry = nil then
7479 RaiseKeyNotInMap;
7480
7481 DeleteEntry(Entry);
7482 end;
7483
7484 {--- TGenTreeMap.DeleteAt ---}
7485 procedure TGenTreeMap.DeleteAt(const Position: TTreeMapCursor);
7486 begin
7487 if Position.TreeMap <> Self then
7488 RaiseCursorDenotesWrongContainer;
7489
7490 if Position.IsNil then
7491 RaiseCursorIsNil;
7492
7493 DeleteEntry(Position.Entry);
7494 end;
7495
7496 {--- TGenTreeMap.DeleteEntry ---}
7497 procedure TGenTreeMap.DeleteEntry(E: PEntry);
7498 var
7499 S, Replacement : PEntry;
7500 begin
7501 Dec(fSize);
7502
7503 if (E^.Left <> nil) and (E^.Right <> nil) then
7504 begin
7505 S := Successor(E);
7506 E^.Key := S^.Key;
7507 E^.Value := S^.Value;
7508 E := S;
7509 end;
7510
7511 if E^.Left <> nil then
7512 Replacement := E^.Left
7513 else
7514 Replacement := E^.Right;
7515
7516 if Replacement <> nil then
7517 begin
7518 Replacement^.Parent := E^.Parent;
7519
7520 if E^.Parent = nil then
7521 fRoot := Replacement
7522 else if E = E^.Parent^.Left then
7523 E^.Parent^.Left := Replacement
7524 else
7525 E^.Parent^.Right := Replacement;
7526
7527 E^.Left := nil;
7528 E^.Right := nil;
7529 E^.Parent := nil;
7530
7531 if E^.Color = cBlack then
7532 RepairAfterDelete(Replacement);
7533 end
7534 else if E^.Parent = nil then
7535 fRoot := nil
7536 else
7537 begin
7538 if E^.Color = cBlack then
7539 RepairAfterDelete(E);
7540
7541 if E^.Parent <> nil then
7542 begin
7543 if E = E^.Parent^.Left then
7544 E^.Parent^.Left := nil
7545 else if E = E^.Parent^.Right then
7546 E^.Parent^.Right := nil;
7547
7548 E^.Parent := nil;
7549 end;
7550 end;
7551 Dispose(E);
7552 end;
7553
7554 {--- TGenTreeMap.DeleteFirst ---}
7555 procedure TGenTreeMap.DeleteFirst;
7556 begin
7557 if fSize = 0 then
7558 RaiseContainerEmpty;
7559
7560 DeleteEntry(GetFirstEntry);
7561 end;
7562
7563 {--- TGenTreeMap.DeleteLast ---}
7564 procedure TGenTreeMap.DeleteLast;
7565 begin
7566 if fSize = 0 then
7567 RaiseContainerEmpty;
7568
7569 DeleteEntry(GetLastEntry);
7570 end;
7571
7572 {--- TGenTreeMap.DeleteTree ---}
7573 procedure TGenTreeMap.DeleteTree(E: PEntry);
7574 var
7575 R, L : PEntry;
7576 begin
7577 while true do
7578 begin
7579 if E = nil then
7580 Exit;
7581
7582 R := E^.Right;
7583 L := E^.Left;
7584
7585 Dispose(E);
7586 Dec(fSize);
7587
7588 DeleteTree(L);
7589
7590 E := R;
7591 end;
7592 end;
7593
7594 {--- TGenTreeMap.EnumeratorGet ---}
TGenTreeMap.EnumeratorGetnull7595 function TGenTreeMap.EnumeratorGet(const Pos: TTreeMapCursor): _TItem_;
7596 begin
7597 ReadItemAt(Pos, Result);
7598 end;
7599
7600 {--- TGenTreeMap.EnumeratorNext ---}
TGenTreeMap.EnumeratorNextnull7601 function TGenTreeMap.EnumeratorNext(var Pos: TTreeMapCursor): Boolean;
7602 begin
7603 if Pos.IsNil then
7604 Pos := First
7605 else
7606 Pos.MoveNext;
7607 Result := Pos.HasItem;
7608 end;
7609
7610 {--- TGenTreeMap.Destroy ---}
7611 destructor TGenTreeMap.Destroy;
7612 begin
7613 Clear;
7614 inherited Destroy;
7615 end;
7616
7617 {--- TGenTreeMap.Exclude ---}
7618 procedure TGenTreeMap.Exclude(const Key: _TKey_);
7619 var
7620 Entry: PEntry;
7621 begin
7622 Entry := GetEntry(Key);
7623 if Entry <> nil then
7624 DeleteEntry(Entry);
7625 end;
7626
7627 {--- TGenTreeMap.Find ---}
Findnull7628 function TGenTreeMap.Find(const Key: _TKey_): TTreeMapCursor;
7629 begin
7630 Result.Init(Self, GetEntry(Key));
7631 end;
7632
7633 {--- TGenTreeMap.First ---}
Firstnull7634 function TGenTreeMap.First: TTreeMapCursor;
7635 begin
7636 Result.Init(Self, GetFirstEntry);
7637 end;
7638
7639 {--- TGenTreeMap.FirstItem ---}
TGenTreeMap.FirstItemnull7640 function TGenTreeMap.FirstItem: _TItem_;
7641 begin
7642 if fSize = 0 then
7643 RaiseContainerEmpty;
7644
7645 Result := GetFirstEntry^.Value;
7646 end;
7647
7648 {--- TGenTreeMap.FirstKey ---}
TGenTreeMap.FirstKeynull7649 function TGenTreeMap.FirstKey: _TKey_;
7650 begin
7651 if fSize = 0 then
7652 RaiseContainerEmpty;
7653
7654 Result := GetFirstEntry^.Key;
7655 end;
7656
7657 {--- TGenTreeMap.RepairAfterDelete ---}
7658 procedure TGenTreeMap.RepairAfterDelete(E: PEntry);
7659 var
7660 Sib : PEntry;
7661 begin
7662 while (E <> fRoot) and (ColorOf(E) = cBlack) do
7663 begin
7664 if E = LeftOf(ParentOf(E)) then
7665 begin
7666 Sib := RightOf(ParentOf(E));
7667
7668 if ColorOf(Sib) = cRed then
7669 begin
7670 SetColor(Sib, cBlack);
7671 SetColor(ParentOf(E), cRed);
7672 RotateLeft(ParentOf(E));
7673 Sib := RightOf(ParentOf(E));
7674 end;
7675
7676 if (ColorOf(LeftOf(Sib)) = cBlack) and (ColorOf(RightOf(Sib)) = cBlack) then
7677 begin
7678 SetColor(Sib, cRed);
7679 E := ParentOf(E);
7680 end
7681 else
7682 begin
7683 if ColorOf(RightOf(Sib)) = cBlack then
7684 begin
7685 SetColor(LeftOf(Sib), cBlack);
7686 SetColor(Sib, cRed);
7687 RotateRight(Sib);
7688 Sib := RightOf(ParentOf(E));
7689 end;
7690
7691 SetColor(Sib, ColorOf(ParentOf(E)));
7692 SetColor(ParentOf(E), cBlack);
7693 SetColor(RightOf(Sib), cBlack);
7694 RotateLeft(ParentOf(E));
7695 E := fRoot;
7696 end;
7697 end
7698 else
7699 begin
7700 Sib := LeftOf(ParentOf(E));
7701
7702 if ColorOf(Sib) = cRed then
7703 begin
7704 SetColor(Sib, cBlack);
7705 SetColor(ParentOf(E), cRed);
7706 RotateRight(ParentOf(E));
7707 Sib := LeftOf(ParentOf(E));
7708 end;
7709
7710 if (ColorOf(RightOf(Sib)) = cBlack) and (ColorOf(LeftOf(Sib)) = cBlack) then
7711 begin
7712 SetColor(Sib, cRed);
7713 E := ParentOf(E);
7714 end
7715 else
7716 begin
7717
7718 if ColorOf(LeftOf(Sib)) = cBlack then
7719 begin
7720 SetColor(RightOf(Sib), cBlack);
7721 SetColor(Sib, cRed);
7722 RotateLeft(Sib);
7723 Sib := LeftOf(ParentOf(E));
7724 end;
7725
7726 SetColor(Sib, ColorOf(ParentOf(E)));
7727 SetColor(ParentOf(E), cBlack);
7728 SetColor(LeftOf(Sib), cBlack);
7729 RotateRight(ParentOf(E));
7730 E := fRoot;
7731 end;
7732 end;
7733 end;
7734
7735 SetColor(E, cBlack);
7736 end;
7737
7738 {--- TGenTreeMap.RepairAfterInsert ---}
7739 procedure TGenTreeMap.RepairAfterInsert(E: PEntry);
7740 var
7741 Y : PEntry;
7742 begin
7743 E^.Color := cRed;
7744
7745 while (E <> nil) and (E <> fRoot) and (E^.Parent^.Color = cRed) do
7746 begin
7747 if ParentOf(E) = LeftOf(ParentOf(ParentOf(E))) then
7748 begin
7749 Y := RightOf(ParentOf(ParentOf(E)));
7750 if ColorOf(Y) = cRed then
7751 begin
7752 SetColor(ParentOf(E), cBlack);
7753 SetColor(Y, cBlack);
7754 SetColor(ParentOf(ParentOf(E)), cRed);
7755 E := ParentOf(ParentOf(E));
7756 end
7757 else
7758 begin
7759 if E = RightOf(ParentOf(E)) then
7760 begin
7761 E := ParentOf(E);
7762 RotateLeft(E);
7763 end;
7764 SetColor(ParentOf(E), cBlack);
7765 SetColor(ParentOf(ParentOf(E)), cRed);
7766 RotateRight(ParentOf(ParentOf(E)));
7767 end;
7768 end
7769 else
7770 begin
7771 Y := LeftOf(ParentOf(ParentOf(E)));
7772 if ColorOf(Y) = cRed then
7773 begin
7774 SetColor(ParentOf(E), cBlack);
7775 SetColor(Y, cBlack);
7776 SetColor(ParentOf(ParentOf(E)), cRed);
7777 E := ParentOf(ParentOf(E));
7778 end
7779 else
7780 begin
7781 if E = LeftOf(ParentOf(E)) then
7782 begin
7783 E := ParentOf(E);
7784 RotateRight(E);
7785 end;
7786 SetColor(ParentOf(E), cBlack);
7787 SetColor(ParentOf(ParentOf(E)), cRed);
7788 RotateLeft(ParentOf(ParentOf(E)));
7789 end;
7790 end;
7791 end;
7792
7793 fRoot^.Color := cBlack;
7794 end;
7795
7796 {--- TGenTreeMap.Floor ---}
Floornull7797 function TGenTreeMap.Floor(const Key: _TKey_): TTreeMapCursor;
7798 begin
7799 Result.Init(Self, GetFloorEntry(Key));
7800 end;
7801
7802 {--- TGenTreeMap.GetEnumerator ---}
TGenTreeMap.GetEnumeratornull7803 function TGenTreeMap.GetEnumerator: TEnumerator;
7804 begin
7805 Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
7806 end;
7807
7808 {--- TGenTreeMap.GetCeilingEntry ---}
GetCeilingEntrynull7809 function TGenTreeMap.GetCeilingEntry(const Key: _TKey_): PEntry;
7810 var
7811 Cmp : Integer;
7812 Ch, Parent : PEntry;
7813 begin
7814 Result := fRoot;
7815 while Result <> nil do
7816 begin
7817 Cmp := fOnCompareKeys(Key, Result^.Key);
7818 if Cmp < 0 then
7819 begin
7820 if Result^.Left <> nil then
7821 Result := Result^.Left
7822 else
7823 Exit;
7824 end
7825 else if Cmp > 0 then
7826 begin
7827 if Result^.Right <> nil then
7828 Result := Result^.Right
7829 else
7830 begin
7831 Parent := Result^.Parent;
7832 Ch := Result;
7833 while (Parent <> nil) and (Ch = Parent^.Right) do
7834 begin
7835 Ch := Parent;
7836 Parent := Parent^.Parent;
7837 end;
7838 Result := Parent;
7839 Exit;
7840 end;
7841 end
7842 else
7843 Exit;
7844 end;
7845 Result := nil;
7846 end;
7847
7848 {--- TGenTreeMap.GetEntry ---}
TGenTreeMap.GetEntrynull7849 function TGenTreeMap.GetEntry(const Key: _TKey_): PEntry;
7850 var
7851 Entry: PEntry;
7852 Cmp : Integer;
7853 begin
7854 Entry := fRoot;
7855 while Entry <> nil do
7856 begin
7857 Cmp := fOnCompareKeys(Key, Entry^.Key);
7858
7859 if Cmp < 0 then
7860 Entry := Entry^.Left
7861 else if Cmp > 0 then
7862 Entry := Entry^.Right
7863 else
7864 begin
7865 Result := Entry;
7866 Exit;
7867 end;
7868 end;
7869 Result := nil;
7870 end;
7871
7872 {--- TGenTreeMap.GetFirstEntry ---}
GetFirstEntrynull7873 function TGenTreeMap.GetFirstEntry: PEntry;
7874 begin
7875 Result := fRoot;
7876 if Result <> nil then
7877 while Result^.Left <> nil do
7878 Result := Result^.Left;
7879 end;
7880
7881 {--- TGenTreeMap.GetFloorEntry ---}
GetFloorEntrynull7882 function TGenTreeMap.GetFloorEntry(const Key: _TKey_): PEntry;
7883 var
7884 Cmp : Integer;
7885 Ch, Parent : PEntry;
7886 begin
7887 Result := fRoot;
7888 while Result <> nil do
7889 begin
7890 Cmp := fOnCompareKeys(Key, Result^.Key);
7891 if Cmp > 0 then
7892 begin
7893 if Result^.Right <> nil then
7894 Result := Result^.Right
7895 else
7896 Exit;
7897 end
7898 else if Cmp < 0 then
7899 begin
7900 if Result^.Left <> nil then
7901 Result := Result^.Left
7902 else
7903 begin
7904 Parent := Result^.Parent;
7905 Ch := Result;
7906 while (Parent <> nil) and (Ch = Parent^.Left) do
7907 begin
7908 Ch := Parent;
7909 Parent := Parent^.Parent;
7910 end;
7911 Result := Parent;
7912 Exit;
7913 end;
7914 end
7915 else
7916 Exit;
7917 end;
7918 Result := nil;
7919 end;
7920
7921 {--- TGenTreeMap.GetItem ---}
GetItemnull7922 function TGenTreeMap.GetItem(const Key: _TKey_): _TItem_;
7923 var
7924 Entry : PEntry;
7925 begin
7926 Entry := GetEntry(Key);
7927 if Entry = nil then
7928 RaiseKeyNotInMap;
7929
7930 Result := Entry^.Value;
7931 end;
7932
7933 {--- TGenTreeMap.GetItemAt ---}
GetItemAtnull7934 function TGenTreeMap.GetItemAt(const Position: TTreeMapCursor): _TItem_;
7935 begin
7936 if Position.TreeMap <> Self then
7937 RaiseCursorDenotesWrongContainer;
7938
7939 if Position.IsNil then
7940 RaiseCursorIsNil;
7941
7942 Result := PEntry(Position.Entry)^.Value;
7943 end;
7944
7945 {--- TGenTreeMap.GetKeyAt ---}
TGenTreeMap.GetKeyAtnull7946 function TGenTreeMap.GetKeyAt(const Position: TTreeMapCursor): _TKey_;
7947 begin
7948 if Position.TreeMap <> Self then
7949 RaiseCursorDenotesWrongContainer;
7950
7951 if Position.IsNil then
7952 RaiseCursorIsNil;
7953
7954 Result := PEntry(Position.Entry)^.Key;
7955 end;
7956
7957 {--- TGenTreeMap.GetLastEntry ---}
GetLastEntrynull7958 function TGenTreeMap.GetLastEntry: PEntry;
7959 begin
7960 Result := fRoot;
7961 if Result <> nil then
7962 while Result^.Right <> nil do
7963 Result := Result^.Right;
7964 end;
7965
7966 {--- TGenTreeMap.Include ---}
7967 procedure TGenTreeMap.Include(const Key: _TKey_; const Value: _TItem_);
7968 var
7969 T, Parent, N : PEntry;
7970 Cmp : Integer;
7971 begin
7972 if fRoot = nil then
7973 begin
7974 fRoot := NewEntry(nil, Key, Value);
7975 fSize := 1;
7976 end
7977 else
7978 begin
7979 T := fRoot;
7980 repeat
7981 Parent := T;
7982 Cmp := fOnCompareKeys(Key, T^.Key);
7983 if Cmp < 0 then
7984 T := T^.Left
7985 else if Cmp > 0 then
7986 T := T^.Right
7987 else
7988 begin
7989 T^.Value := Value;
7990 Exit;
7991 end;
7992 until T = nil;
7993
7994 N := NewEntry(Parent, Key, Value);
7995 if Cmp < 0 then
7996 Parent^.Left := N
7997 else
7998 Parent^.Right := N;
7999 RepairAfterInsert(N);
8000 Inc(fSize);
8001 end;
8002 end;
8003
8004 {--- TGenTreeMap.Insert ---}
8005 procedure TGenTreeMap.Insert(const Key: _TKey_; const Value: _TItem_);
8006 var
8007 Inserted : Boolean;
8008 begin
8009 Insert(Key, Value, Inserted);
8010 if not Inserted then
8011 RaiseKeyAlreadyInMap;
8012 end;
8013
8014 {--- TGenTreeMap.Insert ---}
8015 procedure TGenTreeMap.Insert(const Key: _TKey_; const Value: _TItem_; out
8016 Inserted: Boolean);
8017 var
8018 T, Parent, N : PEntry;
8019 Cmp : Integer;
8020 begin
8021 Inserted := false;
8022 if fRoot = nil then
8023 begin
8024 fRoot := NewEntry(nil, Key, Value);
8025 fSize := 1;
8026 Inserted := true;
8027 end
8028 else
8029 begin
8030 T := fRoot;
8031 repeat
8032 Parent := T;
8033 Cmp := fOnCompareKeys(Key, T^.Key);
8034 if Cmp < 0 then
8035 T := T^.Left
8036 else if Cmp > 0 then
8037 T := T^.Right
8038 else
8039 Exit;
8040 until T = nil;
8041
8042 N := NewEntry(Parent, Key, Value);
8043 if Cmp < 0 then
8044 Parent^.Left := N
8045 else
8046 Parent^.Right := N;
8047 RepairAfterInsert(N);
8048 Inc(fSize);
8049 Inserted := true;
8050 end;
8051 end;
8052
8053 {--- TGenTreeMap.IsEmpty ---}
IsEmptynull8054 function TGenTreeMap.IsEmpty: Boolean;
8055 begin
8056 Result := (fSize = 0);
8057 end;
8058
8059 {--- TGenTreeMap.Last ---}
Lastnull8060 function TGenTreeMap.Last: TTreeMapCursor;
8061 begin
8062 Result.Init(Self, GetLastEntry);
8063 end;
8064
8065 {--- TGenTreeMap.LastItem ---}
LastItemnull8066 function TGenTreeMap.LastItem: _TItem_;
8067 begin
8068 if fSize = 0 then
8069 RaiseContainerEmpty;
8070
8071 Result := GetLastEntry^.Value;
8072 end;
8073
8074 {--- TGenTreeMap.LastKey ---}
LastKeynull8075 function TGenTreeMap.LastKey: _TKey_;
8076 begin
8077 if fSize = 0 then
8078 RaiseContainerEmpty;
8079
8080 Result := GetLastEntry^.Key;
8081 end;
8082
8083 {--- TGenTreeMap.LeftOf ---}
LeftOfnull8084 function TGenTreeMap.LeftOf(E: PEntry): PEntry;
8085 begin
8086 if E = nil then
8087 Result := nil
8088 else
8089 Result := E^.Left;
8090 end;
8091
8092 {--- TGenTreeMap.NewEntry ---}
NewEntrynull8093 function TGenTreeMap.NewEntry(AParent: PEntry; const AKey: _TKey_;
8094 const AValue: _TItem_) : PEntry;
8095 begin
8096 New(Result);
8097 Result^.Parent := AParent;
8098 Result^.Key := AKey;
8099 Result^.Value := AValue;
8100 Result^.Left := nil;
8101 Result^.Right := nil;
8102 end;
8103
8104 {--- TGenTreeMap.ParentOf ---}
ParentOfnull8105 function TGenTreeMap.ParentOf(E: PEntry): PEntry;
8106 begin
8107 if E = nil then
8108 Result := nil
8109 else
8110 Result := E^.Parent;
8111 end;
8112
8113 {--- TGenTreeMap.Predecessor ---}
Predecessornull8114 function TGenTreeMap.Predecessor(E: PEntry): PEntry;
8115 var
8116 Ch : PEntry;
8117 begin
8118 if E = nil then
8119 Result := nil
8120 else if E^.Left <> nil then
8121 begin
8122 Result := E^.Left;
8123 while Result^.Right <> nil do
8124 Result := Result^.Right;
8125 end
8126 else
8127 begin
8128 Result := E^.Parent;
8129 Ch := E;
8130 while (Result <> nil) and (Ch = Result^.Left) do
8131 begin
8132 Ch := Result;
8133 Result := Result^.Parent;
8134 end;
8135 end;
8136 end;
8137
8138 {--- TGenTreeMap.ReadFirstItem ---}
8139 procedure TGenTreeMap.ReadFirstItem(out Value : _TItem_);
8140 begin
8141 if fSize = 0 then
8142 RaiseContainerEmpty;
8143
8144 Value := GetFirstEntry^.Value;
8145 end;
8146
8147 {--- TGenTreeMap.ReadFirstKey ---}
8148 procedure TGenTreeMap.ReadFirstKey(out Key : _TKey_); inline;
8149 begin
8150 if fSize = 0 then
8151 RaiseContainerEmpty;
8152
8153 Key := GetFirstEntry^.Key;
8154 end;
8155
8156 {--- TGenTreeMap.ReadItem ---}
8157 procedure TGenTreeMap.ReadItem(const Key: _TKey_; out Value: _TItem_);
8158 var
8159 Entry : PEntry;
8160 begin
8161 Entry := GetEntry(Key);
8162 if Entry = nil then
8163 RaiseKeyNotInMap;
8164
8165 Value := Entry^.Value;
8166 end;
8167
8168 {--- TGenTreeMap.ReadItemAt ---}
8169 procedure TGenTreeMap.ReadItemAt(const Position: TTreeMapCursor; out Value: _TItem_);
8170 begin
8171 if Position.TreeMap <> Self then
8172 RaiseCursorDenotesWrongContainer;
8173
8174 if Position.IsNil then
8175 RaiseCursorIsNil;
8176
8177 Value := PEntry(Position.Entry)^.Value;
8178 end;
8179
8180 {--- TGenTreeMap.ReadKeyAt ---}
8181 procedure TGenTreeMap.ReadKeyAt(const Position : TTreeMapCursor; out Key: _TKey_);
8182 begin
8183 if Position.TreeMap <> Self then
8184 RaiseCursorDenotesWrongContainer;
8185
8186 if Position.IsNil then
8187 RaiseCursorIsNil;
8188
8189 Key := PEntry(Position.Entry)^.Key;
8190 end;
8191
8192 {--- TGenTreeMap.ReadLastItem ---}
8193 procedure TGenTreeMap.ReadLastItem(out Value : _TItem_);
8194 begin
8195 if fSize = 0 then
8196 RaiseContainerEmpty;
8197
8198 Value := GetLastEntry^.Value;
8199 end;
8200
8201 {--- TGenTreeMap.ReadLastKey ---}
8202 procedure TGenTreeMap.ReadLastKey(out Key : _TKey_); inline;
8203 begin
8204 if fSize = 0 then
8205 RaiseContainerEmpty;
8206
8207 Key := GetLastEntry^.Key;
8208 end;
8209
8210 {--- TGenTreeMap.Replace ---}
8211 procedure TGenTreeMap.Replace(const Key: _TKey_; const Value: _TItem_);
8212 var
8213 Entry : PEntry;
8214 begin
8215 Entry := GetEntry(Key);
8216 if Entry = nil then
8217 RaiseKeyNotInMap;
8218
8219 Entry^.Value := Value;
8220 end;
8221
8222 {--- TGenTreeMap.RightOf ---}
TGenTreeMap.RightOfnull8223 function TGenTreeMap.RightOf(E: PEntry): PEntry;
8224 begin
8225 if E = nil then
8226 Result := nil
8227 else
8228 Result := E^.Right;
8229 end;
8230
8231 {--- TGenTreeMap.RotateLeft ---}
8232 procedure TGenTreeMap.RotateLeft(E: PEntry);
8233 var
8234 R : PEntry;
8235 begin
8236 if E <> nil then
8237 begin
8238 R := E^.Right;
8239
8240 E^.Right := R^.Left;
8241
8242 if R^.Left <> nil then
8243 R^.Left^.Parent := E;
8244
8245 R^.Parent := E^.Parent;
8246 if E^.Parent = nil then
8247 fRoot := R
8248 else if E^.Parent^.Left = E then
8249 E^.Parent^.Left := R
8250 else
8251 E^.Parent^.Right := R;
8252 R^.Left := E;
8253 E^.Parent := R;
8254 end;
8255 end;
8256
8257 {--- TGenTreeMap.RotateRight ---}
8258 procedure TGenTreeMap.RotateRight(E: PEntry);
8259 var
8260 L : PEntry;
8261 begin
8262 if E <> nil then
8263 begin
8264 L := E^.Left;
8265 E^.Left := L^.Right;
8266 if L^.Right <> nil then
8267 L^.Right^.Parent := E;
8268 L^.Parent := E^.Parent;
8269 if E^.Parent = nil then
8270 fRoot := L
8271 else if E^.Parent^.Right = E then
8272 E^.Parent^.Right := L
8273 else
8274 E^.Parent^.Left := L;
8275 L^.Right := E;
8276 E^.Parent := L;
8277 end;
8278 end;
8279
8280 {--- TGenTreeMap.SetColor ---}
8281 procedure TGenTreeMap.SetColor(E: PEntry; Color: TColor);
8282 begin
8283 if E <> nil then
8284 E^.Color := Color;
8285 end;
8286
8287 {--- TGenTreeMap.SetOnCompareKeys ---}
8288 procedure TGenTreeMap.SetOnCompareKeys(AValue: TCompareKeys);
8289 begin
8290 if AValue = nil then
8291 fOnCompareKeys := @DefaultCompareKeys
8292 else
8293 fOnCompareKeys := AValue;
8294 end;
8295
8296 {--- TGenTreeMap.SetOnItemToString ---}
8297 procedure TGenTreeMap.SetOnItemToString(AValue: TItemToString);
8298 begin
8299 if AValue = nil then
8300 fOnItemToString := @DefaultItemToString
8301 else
8302 fOnItemToString := AValue;
8303 end;
8304
8305 {--- TGenTreeMap.SetOnKeyToString ---}
8306 procedure TGenTreeMap.SetOnKeyToString(AValue: TKeyToString);
8307 begin
8308 if AValue = nil then
8309 fOnKeyToString := @DefaultKeyToString
8310 else
8311 fOnKeyToString := AValue;
8312 end;
8313
8314 {--- TGenTreeMap.SetItemAt ---}
8315 procedure TGenTreeMap.SetItemAt(const Position: TTreeMapCursor; Value: _TItem_);
8316 begin
8317 if Position.TreeMap <> Self then
8318 RaiseCursorDenotesWrongContainer;
8319
8320 if Position.IsNil then
8321 RaiseCursorIsNil;
8322
8323 PEntry(Position.Entry)^.Value := Value;
8324 end;
8325
8326 {--- TGenTreeMap.Successor ---}
Successornull8327 function TGenTreeMap.Successor(E: PEntry): PEntry;
8328 var
8329 P, Ch : PEntry;
8330 begin
8331 if E = nil then
8332 Result := nil
8333 else if E^.Right <> nil then
8334 begin
8335 P := E^.Right;
8336 while P^.Left <> nil do
8337 P := P^.Left;
8338 Result := P;
8339 end
8340 else
8341 begin
8342 P := E^.Parent;
8343 Ch := E;
8344 while (P <> nil) and (Ch = P^.Right) do
8345 begin
8346 Ch := P;
8347 P := P^.Parent;
8348 end;
8349 Result := P;
8350 end;
8351 end;
8352
8353 {--- TGenTreeMap.CursorIsFirst ---}
CursorIsFirstnull8354 function TGenTreeMap.CursorIsFirst(const Cursor: TTreeMapCursor): Boolean;
8355 begin
8356 Result := (Cursor.Entry <> nil)
8357 and (Cursor.Entry = (Cursor.TreeMap as TGenTreeMap).GetFirstEntry);
8358 end;
8359
8360 {--- TGenTreeMap.CursorIsLast ---}
TGenTreeMap.CursorIsLastnull8361 function TGenTreeMap.CursorIsLast(const Cursor: TTreeMapCursor): Boolean;
8362 begin
8363 Result := (Cursor.Entry <> nil)
8364 and (Cursor.Entry = (Cursor.TreeMap as TGenTreeMap).GetLastEntry);
8365 end;
8366
8367 {--- TGenTreeMap.CursorMoveNext ---}
8368 procedure TGenTreeMap.CursorMoveNext(const Cursor: TTreeMapCursor);
8369 begin
8370 if Cursor.Entry <> nil then
8371 Cursor.Entry := (Cursor.TreeMap as TGenTreeMap).Successor(Cursor.Entry);
8372 end;
8373
8374 {--- TGenTreeMap.CursorMovePrev ---}
8375 procedure TGenTreeMap.CursorMovePrev(const Cursor: TTreeMapCursor);
8376 begin
8377 if Cursor.Entry <> nil then
8378 Cursor.Entry := (Cursor.TreeMap as TGenTreeMap).Predecessor(Cursor.Entry);
8379 end;
8380
8381 {--- TGenTreeMap.ToString ---}
TGenTreeMap.ToStringnull8382 function TGenTreeMap.ToString: String;
8383 var
8384 Entry, LastEntry : PEntry;
8385 begin
8386 Result := '{';
8387
8388 LastEntry := GetLastEntry;
8389
8390 Entry := GetFirstEntry;
8391 while Entry <> nil do
8392 begin
8393 Result := Result + '(' + fOnKeyToString(Entry^.Key) + '=>' +
8394 fOnItemToString(Entry^.Value) + ')';
8395
8396 if Entry <> LastEntry then
8397 Result := Result + ', ';
8398
8399 Entry := Successor(Entry);
8400 end;
8401
8402 Result := Result + '}';
8403 end;
8404
8405 {======================}
8406 {=== TTreeSetCursor ===}
8407 {======================}
8408
8409 {--- TTreeSetCursor.Equals ---}
TTreeSetCursor.Equalsnull8410 function TTreeSetCursor.Equals(const Cursor: TTreeSetCursor): Boolean;
8411 begin
8412 Result := fPos.Equals(Cursor.fPos)
8413 end;
8414
8415 {--- TTreeSetCursor.HasItem ---}
HasItemnull8416 function TTreeSetCursor.HasItem: Boolean;
8417 begin
8418 Result := fPos.HasItem;
8419 end;
8420
8421 {--- TTreeSetCursor.Init ---}
8422 constructor TTreeSetCursor.Init(TreeSet: TAbstractTreeSet; const APos: TTreeMapCursor);
8423 begin
8424 fTreeSet := TreeSet;
8425 fPos := APos;
8426 end;
8427
8428 {--- TTreeSetCursor.IsFirst ---}
IsFirstnull8429 function TTreeSetCursor.IsFirst: Boolean;
8430 begin
8431 Result := fPos.IsFirst;
8432 end;
8433
8434 {--- TTreeSetCursor.IsLast ---}
IsLastnull8435 function TTreeSetCursor.IsLast: Boolean;
8436 begin
8437 Result := fPos.IsLast;
8438 end;
8439
8440 {--- TTreeSetCursor.IsNil ---}
TTreeSetCursor.IsNilnull8441 function TTreeSetCursor.IsNil: Boolean;
8442 begin
8443 Result := fPos.IsNil;
8444 end;
8445
8446 {--- TTreeSetCursor.MoveNext ---}
8447 procedure TTreeSetCursor.MoveNext;
8448 begin
8449 fPos.MoveNext;
8450 end;
8451
8452 {--- TTreeSetCursor.MovePrevious ---}
8453 procedure TTreeSetCursor.MovePrevious;
8454 begin
8455 fPos.MovePrevious;
8456 end;
8457
8458 {===================}
8459 {=== TGenTreeSet ===}
8460 {===================}
8461
8462 {--- TGenTreeSet.Ceiling ---}
TGenTreeSet.Ceilingnull8463 function TGenTreeSet.Ceiling(const Item: _TItem_): TTreeSetCursor;
8464 begin
8465 Result.Init(Self, fMap.Ceiling(Item));
8466 end;
8467
8468 {--- TGenTreeSet.Clear ---}
8469 procedure TGenTreeSet.Clear;
8470 begin
8471 fMap.Clear;
8472 end;
8473
8474 {--- TGenTreeSet.Contains ---}
Containsnull8475 function TGenTreeSet.Contains(const Item: _TItem_): Boolean;
8476 begin
8477 Result := fMap.Contains(Item);
8478 end;
8479
8480 {--- TGenTreeSet.Create ---}
8481 constructor TGenTreeSet.Create;
8482 begin
8483 fMap := TMap.Create;
8484 fNilCursor.Init(Self, fMap.NilCursor);
8485 SetOnCompareItems(nil);
8486 SetOnItemToString(nil);
8487 end;
8488
8489 {--- TGenTreeSet.DefaultCompareItems ---}
DefaultCompareItemsnull8490 function TGenTreeSet.DefaultCompareItems(const A, B: _TItem_): Integer;
8491 begin
8492 Unused(@A);
8493 Unused(@B);
8494 RaiseMethodNotRedefined;
8495 Result := 0;
8496 end;
8497
8498 {--- TGenTreeSet.DefaultItemToString ---}
DefaultItemToStringnull8499 function TGenTreeSet.DefaultItemToString(const Item: _TItem_): String;
8500 begin
8501 Unused(@Item);
8502 RaiseMethodNotRedefined;
8503 Result := '';
8504 end;
8505
8506 {--- TGenTreeSet.Delete ---}
8507 procedure TGenTreeSet.Delete(const Item: _TItem_);
8508 var
8509 C : TTreeMapCursor;
8510 begin
8511 C := fMap.Find(Item);
8512
8513 if C.IsNil then
8514 RaiseItemNotInSet;
8515
8516 fMap.DeleteAt(C);
8517 end;
8518
8519 {--- TGenTreeSet.DeleteAt ---}
8520 procedure TGenTreeSet.DeleteAt(const Position: TTreeSetCursor);
8521 begin
8522 fMap.DeleteAt(Position.Pos);
8523 end;
8524
8525 {--- TGenTreeSet.DeleteFirst ---}
8526 procedure TGenTreeSet.DeleteFirst;
8527 begin
8528 fMap.DeleteFirst;
8529 end;
8530
8531 {--- TGenTreeSet.DeleteLast ---}
8532 procedure TGenTreeSet.DeleteLast;
8533 begin
8534 fMap.DeleteLast;
8535 end;
8536
8537 {--- TGenTreeSet.Destroy ---}
8538 destructor TGenTreeSet.Destroy;
8539 begin
8540 fMap.Free;
8541 inherited;
8542 end;
8543
8544 {--- TGenTreeSet.Difference ---}
8545 procedure TGenTreeSet.Difference(Left, Right: TGenTreeSet);
8546 begin
8547 if Left <> Self then
8548 begin
8549 Clear;
8550 IncludeAll(Left);
8551 end;
8552
8553 if Left <> Right then
8554 ExcludeAll(Right)
8555 else
8556 Clear;
8557 end;
8558
8559 {--- TGenTreeSet.EnumeratorGet ---}
EnumeratorGetnull8560 function TGenTreeSet.EnumeratorGet(const Pos: TTreeSetCursor): _TItem_;
8561 begin
8562 ReadItemAt(Pos, Result);
8563 end;
8564
8565 {--- TGenTreeSet.EnumeratorNext ---}
EnumeratorNextnull8566 function TGenTreeSet.EnumeratorNext(var Pos: TTreeSetCursor): Boolean;
8567 begin
8568 if Pos.IsNil then
8569 Pos := First
8570 else
8571 Pos.MoveNext;
8572 Result := Pos.HasItem;
8573 end;
8574
8575 {--- TGenTreeSet.ExchangeContent ---}
8576 procedure TGenTreeSet.ExchangeContent(ASet: TGenTreeSet);
8577 var
8578 Tmp : TMap;
8579 begin
8580 Tmp := fMap;
8581 fMap := ASet.fMap;
8582 ASet.fMap := Tmp;
8583 end;
8584
8585 {--- TGenTreeSet.GetOnCompareItems ---}
TGenTreeSet.GetOnCompareItemsnull8586 function TGenTreeSet.GetOnCompareItems: TCompareItems;
8587 begin
8588 Result := fMap.OnCompareKeys;
8589 end;
8590
8591 {--- TGenTreeSet.GetOnItemToString ---}
TGenTreeSet.GetOnItemToStringnull8592 function TGenTreeSet.GetOnItemToString: TItemToString;
8593 begin
8594 Result := fMap.OnKeyToString;
8595 end;
8596
8597 {--- TGenTreeSet.Exclude ---}
8598 procedure TGenTreeSet.Exclude(const Item: _TItem_);
8599 begin
8600 fMap.Exclude(Item);
8601 end;
8602
8603 {--- TGenTreeSet.ExcludeAll ---}
8604 procedure TGenTreeSet.ExcludeAll(ASet: TGenTreeSet);
8605 var
8606 C: TTreeMapCursor;
8607 I: Integer;
8608 begin
8609 if ASet.GetSize > 0 then
8610 begin
8611
8612 C := ASet.fMap.First;
8613 for I := 1 to ASet.GetSize do
8614 begin
8615 Exclude(ASet.fMap.Keys[C]);
8616 C.MoveNext;
8617 end;
8618 end;
8619 end;
8620
8621 {--- TTreeSetCursor ---}
Firstnull8622 function TGenTreeSet.First: TTreeSetCursor;
8623 begin
8624 Result.Init(Self, fMap.First);
8625 end;
8626
8627 {--- TGenTreeSet.FirstItem ---}
TGenTreeSet.FirstItemnull8628 function TGenTreeSet.FirstItem: _TItem_;
8629 begin
8630 fMap.ReadFirstKey(Result);
8631 end;
8632
8633 {--- TGenTreeSet.Floor ---}
Floornull8634 function TGenTreeSet.Floor(const Item: _TItem_): TTreeSetCursor;
8635 begin
8636 Result.Init(Self, fMap.Floor(Item));
8637 end;
8638
8639 {--- TGenTreeSet.GetEnumerator ---}
GetEnumeratornull8640 function TGenTreeSet.GetEnumerator: TEnumerator;
8641 begin
8642 Result := TEnumerator.Create(fNilCursor, @EnumeratorNext, @EnumeratorGet);
8643 end;
8644
8645 {--- TGenTreeSet.GetItemAt ---}
GetItemAtnull8646 function TGenTreeSet.GetItemAt(const Position: TTreeSetCursor): _TItem_;
8647 begin
8648 fMap.ReadKeyAt(Position.Pos, Result);
8649 end;
8650
8651 {--- TGenTreeSet.GetSize ---}
GetSizenull8652 function TGenTreeSet.GetSize: Integer;
8653 begin
8654 Result := fMap.Size;
8655 end;
8656
8657 {--- TGenTreeSet.SetOnCompareItems ---}
8658 procedure TGenTreeSet.SetOnCompareItems(AValue: TCompareItems);
8659 begin
8660 if AValue = nil then
8661 fMap.OnCompareKeys := @DefaultCompareItems
8662 else
8663 fMap.OnCompareKeys := AValue;
8664 end;
8665
8666 {--- TGenTreeSet.SetOnItemToString ---}
8667 procedure TGenTreeSet.SetOnItemToString(AValue: TItemToString);
8668 begin
8669 if AValue = nil then
8670 fMap.OnKeyToString := @DefaultItemToString
8671 else
8672 fMap.OnKeyToString := AValue;
8673 end;
8674
8675 {--- TGenTreeSet.Include ---}
8676 procedure TGenTreeSet.Include(const Item: _TItem_);
8677 begin
8678 fMap.Include(Item, 0);
8679 end;
8680
8681 {--- TGenTreeSet.IncludeAll ---}
8682 procedure TGenTreeSet.IncludeAll(ASet: TGenTreeSet);
8683 var
8684 C: TTreeMapCursor;
8685 I: Integer;
8686 begin
8687 if ASet.GetSize > 0 then
8688 begin
8689 C := ASet.fMap.First;
8690
8691 for I := 1 to ASet.GetSize do
8692 begin
8693 Include(ASet.fMap.Keys[C]);
8694 C.MoveNext;
8695 end;
8696 end;
8697 end;
8698
8699 {--- TGenTreeSet.Insert ---}
8700 procedure TGenTreeSet.Insert(const Item: _TItem_);
8701 var
8702 Inserted : Boolean;
8703 begin
8704 Insert(Item, Inserted);
8705 if not Inserted then
8706 RaiseItemAlreadyInSet;
8707 end;
8708
8709 {--- TGenTreeSet.Insert ---}
8710 procedure TGenTreeSet.Insert(const Item: _TItem_; out Inserted: Boolean);
8711 begin
8712 fMap.Insert(Item, 0, Inserted);
8713 end;
8714
8715 {--- TGenTreeSet.Intersection ---}
8716 procedure TGenTreeSet.Intersection(Left, Right: TGenTreeSet);
8717 var
8718 Inter, Tmp : TGenTreeSet;
8719 I : Integer;
8720 C : TTreeMapCursor;
8721 Item : _TItem_;
8722 begin
8723 if (Left.GetSize = 0) or (Right.GetSize = 0) then
8724 Clear
8725 else
8726 begin
8727 Inter := TGenTreeSet.Create;
8728 Inter.OnCompareItems := OnCompareItems;
8729 Inter.OnItemToString := OnItemToString;
8730
8731 try
8732 if Left.GetSize < Right.GetSize then
8733 begin
8734 Tmp := Left;
8735 Left := Right;
8736 Right := Tmp;
8737 end;
8738
8739 C := Left.fMap.First;
8740 for I := 1 to Left.GetSize do
8741 begin
8742 Item := Left.fMap.Keys[C];
8743 if Right.fMap.Contains(Item) then
8744 Inter.Include(Item);
8745 C.MoveNext;
8746 end;
8747
8748 ExchangeContent(Inter);
8749 finally
8750 Inter.Free;
8751 end;
8752 end;
8753 end;
8754
8755 {--- TGenTreeSet.IsEmpty ---}
IsEmptynull8756 function TGenTreeSet.IsEmpty: Boolean;
8757 begin
8758 Result := fMap.Size = 0;
8759 end;
8760
8761 {--- TGenTreeSet.IsSubset ---}
TGenTreeSet.IsSubsetnull8762 function TGenTreeSet.IsSubset(OfSet: TGenTreeSet): Boolean;
8763 var
8764 I : Integer;
8765 C : TTreeMapCursor;
8766 begin
8767 if GetSize > 0 then
8768 begin
8769 C := fMap.First;
8770 for I := 1 to GetSize do
8771 begin
8772 if not OfSet.fMap.Contains(fMap.Keys[C]) then
8773 begin
8774 Result := false;
8775 Exit;
8776 end;
8777 C.MoveNext;
8778 end;
8779 end;
8780 Result := true;
8781 end;
8782
8783 {--- TGenTreeSet.Last ---}
Lastnull8784 function TGenTreeSet.Last: TTreeSetCursor;
8785 begin
8786 Result.Init(Self, fMap.Last);
8787 end;
8788
8789 {--- TGenTreeSet.LastItem ---}
LastItemnull8790 function TGenTreeSet.LastItem: _TItem_;
8791 begin
8792 fMap.ReadLastKey(Result);
8793 end;
8794
8795 {--- TGenTreeSet.Overlaps ---}
Overlapsnull8796 function TGenTreeSet.Overlaps(ASet: TGenTreeSet): Boolean;
8797 var
8798 I : Integer;
8799 C : TTreeMapCursor;
8800 begin
8801 Result := false;
8802 if GetSize > 0 then
8803 begin
8804 C := fMap.First;
8805 for I := 1 to GetSize do
8806 begin
8807 if ASet.fMap.Contains(fMap.Keys[C]) then
8808 begin
8809 Result := true;
8810 Break;
8811 end;
8812 C.MoveNext;
8813 end;
8814 end;
8815 end;
8816
8817 {--- TGenTreeSet.ReadFirstItem ---}
8818 procedure TGenTreeSet.ReadFirstItem(out Value : _TItem_);
8819 begin
8820 fMap.ReadFirstKey(Value);
8821 end;
8822
8823 {--- TGenTreeSet.ReadItemAt ---}
8824 procedure TGenTreeSet.ReadItemAt(const Position: TTreeSetCursor;
8825 out Value: _TItem_);
8826 begin
8827 fMap.ReadKeyAt(Position.Pos, Value);
8828 end;
8829
8830 {--- TGenTreeSet.ReadLastItem ---}
8831 procedure TGenTreeSet.ReadLastItem(out Value : _TItem_);
8832 begin
8833 fMap.ReadLastKey(Value);
8834 end;
8835
8836 {--- TGenTreeSet.SymmetricDifference ---}
8837 procedure TGenTreeSet.SymmetricDifference(Left, Right: TGenTreeSet);
8838 var
8839 Inter: TGenTreeSet;
8840 begin
8841 Inter := TGenTreeSet.Create;
8842 Inter.OnCompareItems := OnCompareItems;
8843 Inter.OnItemToString := OnItemToString;
8844 try
8845 Inter.Intersection(Left, Right);
8846 Union(Left, Right);
8847 Difference(Self, Inter);
8848 finally
8849 Inter.Free;
8850 end;
8851 end;
8852
8853 {--- TGenTreeSet.ToString ---}
TGenTreeSet.ToStringnull8854 function TGenTreeSet.ToString: String;
8855 var
8856 C : TTreeMapCursor;
8857 begin
8858 Result := '{';
8859
8860 if GetSize > 0 then
8861 begin
8862 C := fMap.First;
8863 while C.HasItem do
8864 begin
8865 Result := Result + fMap.OnKeyToString(fMap.Keys[C]);
8866 if not C.IsLast then
8867 Result := Result + '; ';
8868 C.MoveNext;
8869 end;
8870 end;
8871
8872 Result := Result + '}';
8873 end;
8874
8875 {--- TGenTreeSet.Union ---}
8876 procedure TGenTreeSet.Union(Left, Right: TGenTreeSet);
8877 begin
8878 if Left <> Self then
8879 begin
8880 Clear;
8881 IncludeAll(Left);
8882 end;
8883
8884 if Left <> Right then
8885 IncludeAll(Right);
8886 end;
8887
8888 end.
8889