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