1 { Version 050603. Copyright � Alexey A.Chernobaev, 1996-2005 }
2
3 unit Boolv;
4 {
5 ���������� �������.
6
7 Boolean vectors.
8 }
9
10 interface
11
12 {$I VCheck.inc}
13
14 uses
15 SysUtils, ExtType, ExtSys, VectProc, Vectors, VFormat,
16 {$IFDEF USE_STREAM64}VStrm64{$ELSE}VStream{$ENDIF}, VTxtStrm, VectErr;
17
18 type
19 TBoolVector = class(TSortableVector)
20 protected
21 FDefaultValue: Bool;
GetValuenull22 function GetValue(I: Integer): Bool; virtual;
23 procedure SetValue(I: Integer; Value: Bool); virtual;
24 {$IFDEF V_INLINE}
GetValueInull25 function GetValueI(I: Integer): Bool; inline;
26 procedure SetValueI(I: Integer; Value: Bool); inline;
27 {$ENDIF}
28 procedure InitMemory(Offset, InitCount: Integer); override;
29 public
30 constructor Create(ElemCount: Integer; ADefaultValue: Bool);
31 procedure WriteToStream(VStream: TVStream); override;
32 { ���������� ������ � ����� }
33 { writes the vector to the stream }
34 procedure ReadFromStream(VStream: TVStream); override;
35 { ������ ������ �� ������ }
36 { reads the vector from the stream }
37 procedure WriteToTextStream(TextStream: TTextStream);
38 { ���������� ������ � ��������� ����� }
39 { writes the vector to the text stream }
40 procedure ReadFromTextStream(TextStream: TTextStream);
41 { ������ ������ �� ���������� ������ }
42 { reads the vector from the text stream }
43 procedure Assign(Source: TVector); override;
44 { ����������� ����: TPackedBoolVector, TBoolVector � �� ������� }
45 { compatible types: TPackedBoolVector, TBoolVector and their descendants }
EqualTonull46 function EqualTo(V: TVector): Bool; override;
Comparenull47 function Compare(I: Integer; const V): Int32; override;
48 procedure Exchange(I, J: Integer); override;
49 procedure GetUntyped(I: Integer; var Result); override;
50 procedure SetToDefault;
51 { ������������� ��� �������� � DefaultValue }
52 { set all elements to DefaultValue }
IndexOfnull53 function IndexOf(Value: Bool): Integer;
54 { ���������� ������ ������� ��������� Value � ������ ���� -1 }
55 { returns the index of the first occurrence of Value in the vector or -1 }
56 procedure Insert(I: Integer; Value: Bool); virtual;
57 { ��������� �������� � ������� I }
58 { inserts the value at position I }
Addnull59 function Add(Value: Bool): Integer;
60 { ��������� �������� � ����� ������� � ���������� ��� ������ (Count - 1) }
61 { adds value to the end of the vector and returns it's index (Count - 1) }
62 procedure SetItems(Values: array of Bool);
63 { ������������� �������� ��������� ������� � Values (Count:=High(Values) + 1) }
64 { sets vector elements to Values (Count:=High(Values) + 1) }
65 procedure FillValue(Value: Bool); virtual;
66 { ��������� ���� ��������� �������� Value }
67 { sets all vector elements to Value }
68 procedure FillRandom(ANumTrue: Integer);
69 { ��������� ������ ��������� ������� ���, ����� ���������� True-���������
70 � ��� ����� ����� ����� ANumTrue (��� ����� ������ ���������� � ���������
71 0..Count) }
72 { fills the vector randomly to get vector with ANumTrue True-elements (this
73 number must be in the range 0..Count) }
74 procedure AndVector(T: TBoolVector); virtual;
75 { ���������� �������� }
76 { conjunction of vectors }
77 procedure OrVector(T: TBoolVector); virtual;
78 { ���������� �������� }
79 { disjunction of vectors }
80 procedure XorVector(T: TBoolVector); virtual;
81 { �������� �������� �� ������ ��� }
82 { addition of vectors by modulo two }
83 procedure NotVector; virtual;
84 { ��������� ������� }
85 { negation of the vector }
86 procedure AndItem(I: Integer; Value: Bool); virtual;
87 { Items[I]:=Items[I] and Value }
88 procedure OrItem(I: Integer; Value: Bool); virtual;
89 { Items[I]:=Items[I] or Value }
90 procedure XorItem(I: Integer; Value: Bool); virtual;
91 { Items[I]:=Items[I] xor Value }
92 procedure NotItem(I: Integer); virtual;
93 { Items[I]:=not Items[I] }
Dominatesnull94 function Dominates(T: TBoolVector): Bool;
95 { ���������, ���������� �� ������ Self ��� �������� T (��������� ������ T1
96 ���������� ��� �������� T2, ���� (T2[I] and not T1[I]) = False ��� ���� I,
97 ����� �������, ��� ������ "�������" ������� T2 �� ��������������� �������
98 ������� T1 ����� ��������� "�������") }
99 { checks whether vector Self dominates vector T (boolean vector T1 dominates
100 vector T2 iff (T2[I] and not T1[I]) = False for all I or, in other words,
101 for every True value in the vector T2 the corresponding element in the
102 vector T1 is also True) }
NumTruenull103 function NumTrue: Integer; virtual;
104 { ���������� ����� True-��������� }
105 { returns the number of True-elements }
106 property Items[I: Integer]: Bool read GetValue write SetValue;
107 {$IFNDEF V_INLINE}default;{$ELSE}
108 property ItemsI[I: Integer]: Bool read GetValueI write SetValueI; default;
109 {$ENDIF}
110 property DefaultValue: Bool read FDefaultValue;
111 procedure DebugWrite;
112 procedure DebugWrite01;
113 { ���������� ������; ��� ������ ���������� ���������� � �����������
114 Win32-����������� ���������� ������� ������� � ������� AllocConsole }
115 { debug write; to use in Win32 GUI applications it's necessary to create
116 console with AllocConsole }
117 end;
118
119 TPackedBoolVector = class(TBoolVector)
120 { ����������� ��������� ������ (������ ������� �������� ���� ���) }
121 { packed boolean vector (every element takes one bit) }
122 protected
123 FPackedCount: Integer;
GetCountnull124 function GetCount: Integer; override;
125 procedure SetCount(ACount: Integer); override;
GetValuenull126 function GetValue(I: Integer): Bool; override;
127 procedure SetValue(I: Integer; Value: Bool); override;
128 procedure InitMemory(Offset, InitCount: Integer); override;
129 procedure ClearTail;
130 { �������� "�����������" ����� ���������� ����� }
131 { clears the "extended" part of the last byte }
132 public
NewValuenull133 function NewValue(I: Integer; Value: Bool): Bool;
134 { ����������� ����� �������� I-�� �������� � ���������� ��� ������ �������� }
135 { sets the new value to the element I and returns it's old value }
136 procedure Assign(Source: TVector); override;
137 procedure FillValue(Value: Bool); override;
138 procedure Insert(I: Integer; Value: Bool); override;
139 { ����������� ������������ - ������ ��� ������������� � TBoolVector }
140 { implementation is ineffective - only for compatiblity with TBoolVector }
141 procedure Delete(I: Integer); override;
142 { ����������� ������������ - ������ ��� ������������� � TBoolVector }
143 { implementation is ineffective - only for compatiblity with TBoolVector }
144 procedure AndVector(T: TBoolVector); override;
145 procedure OrVector(T: TBoolVector); override;
146 procedure XorVector(T: TBoolVector); override;
147 procedure NotVector; override;
148 procedure AndItem(I: Integer; Value: Bool); override;
149 procedure OrItem(I: Integer; Value: Bool); override;
150 procedure XorItem(I: Integer; Value: Bool); override;
151 procedure NotItem(I: Integer); override;
NumTruenull152 function NumTrue: Integer; override;
153 {$IFDEF V_INLINE}
154 property Items[I: Integer]: Bool read GetValue write SetValue; default;
155 {$ENDIF}
156 end;
157
158 TBooleanVector = TBoolVector;
159 TPackedBooleanVector = TPackedBoolVector;
160
161 TBoolVectorClass = class of TBoolVector;
162 TPackedBoolVectorClass = class of TPackedBoolVector;
163
CreateBoolVectornull164 function CreateBoolVector(ElemCount: Integer; ADefaultValue: Bool): TBoolVector;
165 { ���� ����� ��������� ���������� ������ ���������� ��� �������� ������� ������
166 TBoolVector � ElemCount ����������, �� ������� ������ ������ TBoolVector,
167 ����� ������� ������ ������ TPackedBoolVector }
168 { if the amount of the free physical memory is large enough to store a vector of
169 class TBoolVector with ElemCount elements then creates such vector else creates
170 a vector of class TPackedBoolVector }
171
172 implementation
173
174 { TBoolVector }
175
176 constructor TBoolVector.Create(ElemCount: Integer; ADefaultValue: Bool);
177 begin
178 inherited Create(SizeOf(Bool));
179 FDefaultValue:=ADefaultValue;
180 SetCount(ElemCount);
181 end;
182
183 procedure TBoolVector.InitMemory(Offset, InitCount: Integer);
184 begin
185 FillChar(FItems^.BoolArray[Offset], InitCount, FDefaultValue);
186 end;
187
188 procedure TBoolVector.WriteToStream(VStream: TVStream);
189 begin
190 inherited WriteToStream(VStream);
191 VStream.WriteProc(FDefaultValue, SizeOf(FDefaultValue));
192 end;
193
194 procedure TBoolVector.ReadFromStream(VStream: TVStream);
195 begin
196 inherited ReadFromStream(VStream);
197 VStream.ReadProc(FDefaultValue, SizeOf(FDefaultValue));
198 end;
199
200 procedure TBoolVector.WriteToTextStream(TextStream: TTextStream);
201 var
202 I: Integer;
203 S: String;
204 begin
205 S:='';
206 for I:=0 to Count - 1 do begin
207 if I > 0 then
208 S:=S + ' ';
209 S:=S + IntToStr(Ord(Items[I]));
210 end;
211 TextStream.WriteString(S);
212 end;
213
214 procedure TBoolVector.ReadFromTextStream(TextStream: TTextStream);
215 var
216 I: Integer;
217 C, LastChar: Char;
218 S, Value: String;
219 begin
220 Clear;
221 S:=TextStream.ReadString + ' ';
222 LastChar:=' ';
223 Value:='';
224 for I:=1 to Length(S) do begin
225 C:=S[I];
226 if C = #9 then
227 C:=' ';
228 if (C = ' ') and (C <> LastChar) then begin
229 Add(StrToBool(Value));
230 Value:='';
231 end
232 else
233 Value:=Value + C;
234 LastChar:=C;
235 end;
236 end;
237
238 procedure TBoolVector.Assign(Source: TVector);
239 var
240 I: Integer;
241 begin
242 if Source is TBoolVector then begin
243 if Source is TPackedBoolVector then begin
244 Count:=Source.Count;
245 for I:=0 to Source.Count - 1 do
246 Items[I]:=TPackedBoolVector(Source).Items[I];
247 end
248 else
249 inherited Assign(Source);
250 FDefaultValue:=TBoolVector(Source).FDefaultValue;
251 end
252 else
253 Error(SAssignError);
254 end;
255
TBoolVector.Comparenull256 function TBoolVector.Compare(I: Integer; const V): Int32;
257 begin
258 Result:=Ord(Items[I]) - Ord(Bool(V));
259 end;
260
261 procedure TBoolVector.Exchange(I, J: Integer);
262 var
263 B: Bool;
264 begin
265 B:=Items[I];
266 Items[I]:=Items[J];
267 Items[J]:=B;
268 end;
269
270 procedure TBoolVector.GetUntyped(I: Integer; var Result);
271 begin
272 Bool(Result):=Items[I];
273 end;
274
275 procedure TBoolVector.SetToDefault;
276 begin
277 InitMemory(0, FCount);
278 end;
279
IndexOfnull280 function TBoolVector.IndexOf(Value: Bool): Integer;
281 var
282 I: Integer;
283 begin
284 for I:=0 to Count - 1 do
285 if Items[I] = Value then begin
286 Result:=I;
287 Exit;
288 end;
289 Result:=-1;
290 end;
291
292 procedure TBoolVector.Insert(I: Integer; Value: Bool);
293 begin
294 Expand(I);
295 Items[I]:=Value;
296 end;
297
Addnull298 function TBoolVector.Add(Value: Bool): Integer;
299 begin
300 Result:=Count;
301 Grow(1);
302 Items[Result]:=Value;
303 end;
304
305 procedure TBoolVector.SetItems(Values: array of Bool);
306 var
307 I: Integer;
308 begin
309 Count:=High(Values) + 1;
310 for I:=0 to High(Values) do
311 Items[I]:=Values[I];
312 end;
313
314 procedure TBoolVector.FillValue(Value: Bool);
315 begin
316 FillChar(FItems^.BoolArray[0], FCount, Value);
317 end;
318
319 procedure TBoolVector.FillRandom(ANumTrue: Integer);
320
321 procedure FillRange(L, R, ANumTrue: Integer);
322 var
323 RangeLength, Offset, Avg, LeftNumTrue: Integer;
324 begin
325 if (L <= R) and (ANumTrue > 0) then begin
326 RangeLength:=R - L + 1;
327 Offset:=Random(RangeLength);
328 Avg:=L + Offset;
329 Items[Avg]:=True;
330 Dec(ANumTrue);
331 LeftNumTrue:=Round(Offset * ANumTrue / RangeLength);
332 FillRange(L, Avg - 1, LeftNumTrue);
333 FillRange(Avg + 1, R, ANumTrue - LeftNumTrue);
334 end;
335 end;
336
337 var
338 N: Integer;
339 Inv: Bool;
340 begin
341 {$IFDEF CHECK_VECTORS}
342 if (ANumTrue < 0) or (ANumTrue > Count) then Error(SErrorInParameters);
343 {$ENDIF}
344 N:=Count;
345 if ANumTrue > N div 2 then begin
346 ANumTrue:=N - ANumTrue;
347 Inv:=True;
348 end
349 else
350 Inv:=False;
351 FillValue(False);
352 FillRange(0, N - 1, ANumTrue);
353 if Inv then
354 NotVector;
355 end;
356
357 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
TBoolVector.EqualTonull358 function TBoolVector.EqualTo(V: TVector): Bool;
359 var
360 I, N: Integer;
361 begin
362 if V is TBoolVector then
363 if ClassType = V.ClassType then begin
364 if Self is TPackedBoolVector then begin
365 TPackedBoolVector(Self).ClearTail;
366 TPackedBoolVector(V).ClearTail;
367 end;
368 Result:=inherited EqualTo(V);
369 end
370 else begin
371 Result:=False;
372 N:=Count;
373 if N = V.Count then begin
374 for I:=0 to N - 1 do
375 if Items[I] <> TBoolVector(V)[I] then
376 Exit;
377 Result:=True;
378 end;
379 end
380 else
381 Error(SIncompatibleClasses);
382 end;
383 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
384
TBoolVector.GetValuenull385 function TBoolVector.GetValue(I: Integer): Bool;
386 begin
387 {$IFDEF CHECK_VECTORS}
388 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
389 {$ENDIF}
390 Result:=PBoolArray(FItems)^[I];
391 end;
392
393 procedure TBoolVector.SetValue(I: Integer; Value: Bool);
394 begin
395 {$IFDEF CHECK_VECTORS}
396 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
397 {$ENDIF}
398 PBoolArray(FItems)^[I]:=Value;
399 end;
400
401 {$IFDEF V_INLINE}
GetValueInull402 function TBoolVector.GetValueI(I: Integer): Bool;
403 begin
404 {$IFDEF CHECK_VECTORS}
405 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
406 {$ENDIF}
407 Result:=PBoolArray(FItems)^[I];
408 end;
409
410 procedure TBoolVector.SetValueI(I: Integer; Value: Bool);
411 begin
412 {$IFDEF CHECK_VECTORS}
413 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
414 {$ENDIF}
415 PBoolArray(FItems)^[I]:=Value;
416 end;
417 {$ENDIF}
418
419 procedure TBoolVector.AndVector(T: TBoolVector);
420 var
421 I: Integer;
422 begin
423 {$IFDEF CHECK_VECTORS}
424 if Count <> T.Count then ErrorFmt(SWrongVectorSize_d, [T.Count]);
425 {$ENDIF}
426 if ClassType = T.ClassType then
427 AndBoolProc(FItems^, T.FItems^, FCount)
428 else
429 for I:=0 to Count - 1 do
430 FItems^.BoolArray[I]:=FItems^.BoolArray[I] and T[I];
431 end;
432
433 procedure TBoolVector.OrVector(T: TBoolVector);
434 var
435 I: Integer;
436 begin
437 {$IFDEF CHECK_VECTORS}
438 if Count <> T.Count then ErrorFmt(SWrongVectorSize_d, [T.Count]);
439 {$ENDIF}
440 if ClassType = T.ClassType then
441 OrBoolProc(FItems^, T.FItems^, FCount)
442 else
443 for I:=0 to Count - 1 do
444 FItems^.BoolArray[I]:=FItems^.BoolArray[I] or T[I];
445 end;
446
447 procedure TBoolVector.XorVector(T: TBoolVector);
448 var
449 I: Integer;
450 begin
451 {$IFDEF CHECK_VECTORS}
452 if Count <> T.Count then ErrorFmt(SWrongVectorSize_d, [T.Count]);
453 {$ENDIF}
454 if ClassType = T.ClassType then
455 XorBoolProc(FItems^, T.FItems^, FCount)
456 else
457 for I:=0 to Count - 1 do
458 FItems^.BoolArray[I]:=FItems^.BoolArray[I] xor T[I];
459 end;
460
461 procedure TBoolVector.NotVector;
462 begin
463 NotBoolProc(FItems^, FItems^, FCount);
464 end;
465
466 procedure TBoolVector.AndItem(I: Integer; Value: Bool);
467 begin
468 {$IFDEF CHECK_VECTORS}
469 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
470 {$ENDIF}
471 PBoolArray(FItems)^[I]:=PBoolArray(FItems)^[I] and Value;
472 end;
473
474 procedure TBoolVector.OrItem(I: Integer; Value: Bool);
475 begin
476 {$IFDEF CHECK_VECTORS}
477 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
478 {$ENDIF}
479 PBoolArray(FItems)^[I]:=PBoolArray(FItems)^[I] or Value;
480 end;
481
482 procedure TBoolVector.XorItem(I: Integer; Value: Bool);
483 begin
484 {$IFDEF CHECK_VECTORS}
485 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
486 {$ENDIF}
487 PBoolArray(FItems)^[I]:=PBoolArray(FItems)^[I] xor Value;
488 end;
489
490 procedure TBoolVector.NotItem(I: Integer);
491 begin
492 {$IFDEF CHECK_VECTORS}
493 if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
494 {$ENDIF}
495 PBoolArray(FItems)^[I]:=not PBoolArray(FItems)^[I];
496 end;
497
TBoolVector.Dominatesnull498 function TBoolVector.Dominates(T: TBoolVector): Bool;
499 var
500 I, N, N1, N2: Integer;
501 C: TClass;
502 begin
503 N1:=Count;
504 N2:=T.Count;
505 if N1 < N2 then begin
506 for I:=N1 to N2 - 1 do
507 if T[I] then begin
508 Result:=False;
509 Exit;
510 end;
511 N:=N1;
512 end
513 else
514 N:=N2;
515 C:=ClassType;
516 if (C = T.ClassType) and (C = TBoolVector) then
517 Result:=BoolDominateFunc(FItems^, T.FItems^, N)
518 else begin
519 for I:=0 to N - 1 do
520 if T[I] and not Items[I] then begin
521 Result:=False;
522 Exit;
523 end;
524 Result:=True;
525 end;
526 end;
527
NumTruenull528 function TBoolVector.NumTrue: Integer;
529 begin
530 Result:=CountEqualToValue8(FItems^, Int8(True), FCount);
531 end;
532
533 procedure TBoolVector.DebugWrite;
534 var
535 I: Integer;
536 begin
537 for I:=0 to Count - 1 do
538 write(Items[I], ' ');
539 writeln;
540 end;
541
542 procedure TBoolVector.DebugWrite01;
543 var
544 I: Integer;
545 begin
546 for I:=0 to Count - 1 do
547 write(Ord(Items[I]), ' ');
548 writeln;
549 end;
550
551 { TPackedBoolVector }
552
553 procedure TPackedBoolVector.InitMemory(Offset, InitCount: Integer);
554 var
555 Value: UInt8;
556 begin
557 if FDefaultValue then
558 Value:=$FF
559 else
560 Value:=0;
561 FillChar(FItems^.UInt8Array[Offset], InitCount, Value);
562 end;
563
564 procedure TPackedBoolVector.ClearTail;
565 var
566 T: UInt8;
567 I: Integer;
568 begin
569 T:=FPackedCount mod 8;
570 if T > 0 then begin
571 T:=8 - T;
572 I:=FCount - 1;
573 FItems^.UInt8Array[I]:=UInt8(FItems^.UInt8Array[I] shl T) shr T;
574 end;
575 end;
576
TPackedBoolVector.GetCountnull577 function TPackedBoolVector.GetCount: Integer;
578 begin
579 Result:=FPackedCount;
580 end;
581
582 procedure TPackedBoolVector.SetCount(ACount: Integer);
583 var
584 T1, T2, SetBits: UInt8;
585 I, OldCount: Integer;
586 begin
587 OldCount:=FCount;
588 inherited SetCount((ACount + 7) div 8);
589 { �������������� "�����" ���� � ��������� ����� }
590 if (ACount > FPackedCount) and (OldCount = FCount) then begin
591 I:=FCount - 1;
592 T1:=FPackedCount mod 8;
593 T2:=8 - T1;
594 SetBits:=UInt8(FItems^.UInt8Array[I] shl T2) shr T2;
595 if FDefaultValue then
596 FItems^.UInt8Array[I]:=UInt8($FF shl T1) or SetBits
597 else
598 FItems^.UInt8Array[I]:=SetBits;
599 end;
600 FPackedCount:=ACount;
601 end;
602
TPackedBoolVector.GetValuenull603 function TPackedBoolVector.GetValue(I: Integer): Bool;
604 begin
605 {$IFDEF CHECK_VECTORS}
606 if (I < 0) or (I >= FPackedCount) then ErrorFmt(SRangeError_d, [I]);
607 {$ENDIF}
608 Result:=FItems^.UInt8Array[I div 8] and (1 shl (I mod 8)) <> 0;
609 end;
610
611 procedure TPackedBoolVector.SetValue(I: Integer; Value: Bool);
612 begin
613 NewValue(I, Value);
614 end;
615
TPackedBoolVector.NewValuenull616 function TPackedBoolVector.NewValue(I: Integer; Value: Bool): Bool;
617 var
618 Mask, T: UInt8;
619 begin
620 {$IFDEF CHECK_VECTORS}
621 if (I < 0) or (I >= FPackedCount) then ErrorFmt(SRangeError_d, [I]);
622 {$ENDIF}
623 Mask:=1 shl (I mod 8);
624 I:=I div 8;
625 With FItems^ do begin
626 T:=UInt8Array[I];
627 Result:=T and Mask <> 0;
628 if Value then
629 UInt8Array[I]:=T or Mask
630 else
631 UInt8Array[I]:=T and not Mask;
632 end;
633 end;
634
635 procedure TPackedBoolVector.Assign(Source: TVector);
636 var
637 I: Integer;
638 begin
639 if Source is TBoolVector then begin
640 FDefaultValue:=TBoolVector(Source).FDefaultValue;
641 if Source is TPackedBoolVector then begin
642 inherited Assign(Source);
643 FPackedCount:=TPackedBoolVector(Source).FPackedCount;
644 end
645 else begin
646 Count:=Source.Count;
647 for I:=0 to Source.Count - 1 do
648 NewValue(I, TBoolVector(Source).Items[I]);
649 end;
650 end
651 else
652 Error(SAssignError);
653 end;
654
655 procedure TPackedBoolVector.FillValue(Value: Bool);
656 var
657 AFillValue: UInt8;
658 begin
659 if Value then
660 AFillValue:=$FF
661 else
662 AFillValue:=0;
663 FillChar(FItems^.UInt8Array[0], FCount, AFillValue);
664 end;
665
666 procedure TPackedBoolVector.Insert(I: Integer; Value: Bool);
667 var
668 J: Integer;
669 begin
670 Grow(1);
671 for J:=Count - 1 downto I + 1 do
672 Items[J]:=Items[J - 1];
673 Items[I]:=Value;
674 end;
675
676 procedure TPackedBoolVector.Delete(I: Integer);
677 var
678 J: Integer;
679 begin
680 for J:=I to Count - 2 do
681 Items[J]:=Items[J + 1];
682 Count:=Count - 1;
683 end;
684
685 procedure TPackedBoolVector.AndVector(T: TBoolVector);
686 var
687 I: Integer;
688 begin
689 {$IFDEF CHECK_VECTORS}
690 if Count <> T.Count then ErrorFmt(SWrongVectorSize_d, [T.Count]);
691 {$ENDIF}
692 if T is TPackedBoolVector then
693 AndBoolProc(FItems^, T.FItems^, FCount)
694 else
695 for I:=0 to Count - 1 do
696 Items[I]:=Items[I] and T[I];
697 end;
698
699 procedure TPackedBoolVector.OrVector(T: TBoolVector);
700 var
701 I: Integer;
702 begin
703 {$IFDEF CHECK_VECTORS}
704 if Count <> T.Count then ErrorFmt(SWrongVectorSize_d, [T.Count]);
705 {$ENDIF}
706 if T is TPackedBoolVector then
707 OrBoolProc(FItems^, T.FItems^, FCount)
708 else
709 for I:=0 to Count - 1 do
710 Items[I]:=Items[I] or T[I];
711 end;
712
713 procedure TPackedBoolVector.XorVector(T: TBoolVector);
714 var
715 I: Integer;
716 begin
717 {$IFDEF CHECK_VECTORS}
718 if Count <> T.Count then ErrorFmt(SWrongVectorSize_d, [T.Count]);
719 {$ENDIF}
720 if T is TPackedBoolVector then
721 XorBoolProc(FItems^, T.FItems^, FCount)
722 else
723 for I:=0 to Count - 1 do
724 Items[I]:=Items[I] xor T[I];
725 end;
726
727 procedure TPackedBoolVector.NotVector;
728 var
729 I: Integer;
730 begin
731 for I:=0 to FCount - 1 do
732 With FItems^ do UInt8Array[I]:=not UInt8Array[I];
733 end;
734
NumTruenull735 function TPackedBoolVector.NumTrue: Integer;
736 const
737 NumberOfSetBit: array [0..255] of UInt8 = (
738 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3,
739 3, 4, 3, 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4,
740 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4,
741 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5,
742 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 1, 2,
743 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, 5,
744 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5,
745 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
746 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5,
747 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
748 var
749 I: Integer;
750 begin
751 ClearTail;
752 Result:=0;
753 for I:=0 to FCount - 1 do
754 Result:=Result + NumberOfSetBit[FItems^.UInt8Array[I]];
755 end;
756
757 procedure TPackedBoolVector.AndItem(I: Integer; Value: Bool);
758 begin
759 NewValue(I, GetValue(I) and Value);
760 end;
761
762 procedure TPackedBoolVector.OrItem(I: Integer; Value: Bool);
763 begin
764 NewValue(I, GetValue(I) or Value);
765 end;
766
767 procedure TPackedBoolVector.XorItem(I: Integer; Value: Bool);
768 begin
769 NewValue(I, GetValue(I) xor Value);
770 end;
771
772 procedure TPackedBoolVector.NotItem(I: Integer);
773 begin
774 NewValue(I, not GetValue(I));
775 end;
776
CreateBoolVectornull777 function CreateBoolVector(ElemCount: Integer; ADefaultValue: Bool): TBoolVector;
778 begin
779 if PhysicalMemoryFree > ElemCount then
780 Result:=TBoolVector.Create(ElemCount, ADefaultValue)
781 else
782 Result:=TPackedBoolVector.Create(ElemCount, ADefaultValue);
783 end;
784
785 end.
786