Least significant set bit in a set

[Thaddy]

default alignment is 4 indeed, but you can change that.

[LemonParty]

Inlining works.

Updated code with cycle:

Code: Pascal  [Select][+][-]

1. resourcestring
2.   rsSetTooLarge = 'Set too large';
3.   rsNotaSet = 'Not a set';
4.   rsEmptySet = 'Empty set';
5.  
6. function FirstInSet<T{:set}>(aSet: T): SizeUInt;inline;
7. type
8.   HWord = record a,b,c,d: QWord; end; PHWord = ^HWord;
9.   QWordArray = array [1..4] of QWord;
10.   PQWordArray = ^QWordArray;
11. var
12.   pTail: PByte;
13.   i: LongInt;
14. begin
15.   if GetTypeKind(T) <> tkSet then
16.     raise ESetException.Create(rsNotaSet);
17.  
18.   Result:= 0;
19.   for i:= 1 to SizeOf(T) div 8 do begin
20.     Result:= BsfQWord(PQWordArray(@aSet)^[i]);
21.     if Result <> 255
22.       then Exit(Result + 64 * (i - 1));
23.   end;
24.  
25.   if (SizeOf(T) mod 8) = 0 then begin
26.     if Result = 255 then
27.       raise ESetException.Create(rsEmptySet);
28.   end else begin
29.     pTail:= @aSet + (SizeOf(T) and -8);
30.     case SizeOf(T) mod 8 of
31.     1: Result:= BsfByte(PByte(pTail)^);
32.     2: Result:= BsfWord(PWord(pTail)^);
33.     3: Result:= BsfDWord(PWord(pTail)^ + PByte(pTail + 2)^ shl 16);
34.     4: Result:= BsfDWord(PDWord(pTail)^);
35.     5: Result:= BsfQWord(PDWord(pTail)^ + QWord(PByte(pTail + 4)^) shl 32);
36.     6: Result:= BsfQWord(PDWord(pTail)^ + QWord(PWord(pTail + 4)^) shl 32);
37.     7: Result:= BsfQWord(PDWord(pTail)^ + QWord(PWord(pTail + 4)^) shl 32 + QWord(PByte(pTail + 6)^) shl 48);
38.     end;
39.  
40.     if Result = 255
41.       then raise ESetException.Create(rsEmptySet);
42.  
43.     inc(Result, 64 * (SizeOf(T) div 8));
44.   end;
45. end;
46.  

[MathMan]

Inlining works.

Nice. However I think that some unaligned typecasts may be in order, as not all CPU support misaligned fetch and depending on the memory layout defined a set may start at an arbitrary byte address. Or am i wrong?

[Kays]

Is there an intrinsic to find least significant element that included in a set? […]

To answer your question – apparently that was asked too much – no, there is not. You’ll have to implement such functionality on your own. I’m shocked to see that even veteran forum members are not capable of translating something mundane as min(M ≠ ∅) ≔ x: ∀ y ∊ M: x ≤ y to Pascal:

Code: Pascal  [Select][+][-]

1.         type
2.                 flag = (A, B, C, D, E, F);
3.                 flags = set of flag;
4.         function minimum(sample: flags): flag;
5.                 var
6.                         element, result: flag;
7.                 begin
8.                         { Set intermediate `result` to maximum possible element. }
9.                         result := F;
10.                         { Extended Pascal defines `for`‐iteration over `set`s. }
11.                         for element in sample do
12.                         begin
13.                                 { Is current item less than intermediate `result`? }
14.                                 if element < result then
15.                                 begin
16.                                         result := element
17.                                 end
18.                         end;
19.                         { NB: This returns `F` in case of an empty set. }
20.                         minimum := result
21.                 end;

[Thaddy]

@Kays
You forgot to exit early so the loops run inefficient. It is also wrong: it keeps the last in sample, not the first it encounters.

How about simply:

Code: Pascal  [Select][+][-]

1. {$ifdef fpc}{$mode delphi}{$endif}
2. ype  
3.  TRange = 0..255;
4.  TSet   = set of TRange;
5.  TColor = (red,white,blue,yellow,magenta,green);
6.  TColors = set of TColor;
7.  
8.  function bsrset<_S,_R>(const value:_S):integer;inline;
9.  var r:_R;
10.  begin
11.   result := -1;
12.   // first found is lsb
13.   if GetTypeKind(_S) = tkSet then
14.     for r in value do exit(ord(r));
15.  end;
16.  
17.  
18.  function bsfset<_S,_R>(const value:_S):integer;inline;
19.  var r:_R;
20.  begin
21.    result := -1;
22.   // first found is msb
23.   if GetTypeKind(_S) = tkSet then
24.   for r := High(r) downto low(r) do
25.      if r in value then exit(ord(r));
26.  end;
27.  
28. var
29.   a:Tset = [4,8,9,33];
30.   c:Tcolors =[white,blue,magenta];
31. begin
32.   writeln(bsrset<TSet,TRange>(a));
33.   writeln(bsfset<TSet,TRange>(a));
34.   writeln(bsrset<Tcolors,TColor>(c));
35.   writeln(bsfset<Tcolors,TColor>(c));
36. end.

Maybe slow but sure and short.

Come to think of it, also check if _R is an enumerable type, like [tkEnumeration, TChar, tkInteger].
Will add that later.

I think this is the easiest, not the fastest.

[jamie]

Is there an intrinsic to find least significant element that included in a set? […]

To answer your question – apparently that was asked too much – no, there is not. You’ll have to implement such functionality on your own. I’m shocked to see that even veteran forum members are not capable of translating something mundane as min(M ≠ ∅) ≔ x: ∀ y ∊ M: x ≤ y to Pascal:

Code: Pascal  [Select][+][-]

1.         type
2.                 flag = (A, B, C, D, E, F);
3.                 flags = set of flag;
4.         function minimum(sample: flags): flag;
5.                 var
6.                         element, result: flag;
7.                 begin
8.                         { Set intermediate `result` to maximum possible element. }
9.                         result := F;
10.                         { Extended Pascal defines `for`‐iteration over `set`s. }
11.                         for element in sample do
12.                         begin
13.                                 { Is current item less than intermediate `result`? }
14.                                 if element < result then
15.                                 begin
16.                                         result := element
17.                                 end
18.                         end;
19.                         { NB: This returns `F` in case of an empty set. }
20.                         minimum := result
21.                 end;

LOL, my hat off to you @Kays. You smoked them! 

Jamie

[Thaddy]

And his code is wrong? Didn't you notice? He smoked himself.

Code: Pascal  [Select][+][-]

1.  for element in sample do
2.                         begin
3.                                 { Is current item less than intermediate `result`? }
4.                                 if element < result then
5.                                 begin
6.                                         result := element // <--- this is bsr? or bsf?
7.                                 end
8.                         end;
9.  
10.  

should be:

Code: Pascal  [Select][+][-]

1.  for element in sample do
2.                         begin
3.                                 { Is current item less than intermediate `result`? }
4.                                 if element < result then
5.                                         exit(element) // first hit, not last....basics
6.                         end;

It is also even slower than my approach using the same in.
LOL....

Bits are right to left.
Sets are left to right.

Now can I call his code "stupid"? It looks like it....
I am sure he would reconsider his over-confident statement.

Dead give away is the horrible code formatting.

Have a look at:

Code: Pascal  [Select][+][-]

1. function bsrset2<_S,_R>(const value:_S;out outval:_R):boolean;inline;
2. const
3.   TOrdinals:set of TTypekind = [tkChar,tkInteger,tkEnumeration];// probably not complete  
4. var
5.   r:_R;
6. begin
7.    Result := false;
8.    writeln(GetTypeKind(_R));
9.    if (GetTypeKind(_S) = tkSet) and (getTypekind(_R) in TOrdinals) then
10.    // first found is lsb
11.    for r in value do
12.    begin
13.       outval := r;
14.       exit(true); // exit at the first attempt
15.    end;
16. end;

[jamie]

This is my last replay on this. Its getting ridiculous now

Code: Pascal  [Select][+][-]

1.  
2. unit Unit1;
3.  
4. {$mode delphi}{$H+}
5.  
6. interface
7.  
8. uses
9.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, types;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
17.   private
18.  
19.   public
20.  
21.   end;
22.  
23. var
24.   Form1: TForm1;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TForm1 }
31. function BigBsf(Const aValue; ASize: integer): integer;
32. label
33.   ScanIt;
34. var
35.   P: Pointer;
36. begin
37.   if ASize < 1 then Exit(-1);
38.   P := @AValue;
39.   ScanIt:
40.     case ASize of
41.       1: Exit(shortint(BsfByte(pbyte(P)^)));
42.       2..3: begin
43.         Result := shortint(BsfWord(PWord(P)^));
44.         Dec(aSize, 2);
45.         Inc(P, 2);
46.         if Result = -1 then goto ScanIt;
47.       end;
48.       4..7: begin
49.         Result := shortint(BsfDWord(PDWord(P)^));
50.         Dec(aSize, 4);
51.         Inc(P, 4);
52.         if Result = -1 then goto ScanIt;
53.       end;
54.       8..255: begin
55.         Result := shortint(BsfQWord(PQWord(P)^));
56.         Dec(aSize, 8);
57.         Inc(P, 8);
58.         if Result = -1 then goto ScanIt;
59.       end;
60.     end;
61. end;
62.  
63. function FirstItemCardinality<T>(var aSet): integer; inline;
64. begin
65.   Result := BigBsf(aSet, Sizeof(T));
66. end;
67.  
68. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
69. begin
70.   Caption := FirstItemCardinality<TShiftState>(Shift).Tostring;
71. end;
72.  
73. end.
74.  

Now that is lard, just not as much as I've seen here but I can only assume the other nonstandard set sizes will work, the logic looks ok. I am sure others will find errors in it!
Jamie

[Thaddy]

Bad code. Must I really conclude both of  you did not even test your code? At least I took that effort.
You look silly Jamie, sorry, but I mean that. Otherwise I respect your contributions but here you are proven wrong, as is Kays.
Kays code is wrong and I showed it.
Your comments seem not very knowledgeable to me....
You can do better...

[jamie]

I just deleted the last one I did. I created a oversized array of various sizes and tested it, I now have the multiplier in there.

Code: Pascal  [Select][+][-]

1. function BigBsf(Const aValue; ASize: integer): integer;
2. label
3.   ScanIt;
4. var
5.   P: Pointer;
6.   I:Integer=0;
7.   Added:INteger=0;
8. begin
9.   if ASize < 1 then Exit(-1);
10.   P := @AValue;
11.   ScanIt:
12.    Dec(ASize,I);
13.    Inc(P,I);
14.    Inc(AddEd, I);
15.     case ASize of
16.       1: Result := shortint(BsfByte(pbyte(P)^));
17.       2..3: begin
18.         Result := shortint(BsfWord(PWord(P)^));
19.         I:=2;
20.         if Result = -1 then goto ScanIt;
21.       end;
22.       4..7: begin
23.         Result := shortint(BsfDWord(PDWord(P)^));
24.         I:=4;
25.         if Result = -1 then goto ScanIt;
26.       end;
27.       8..255: begin
28.         Result := shortint(BsfQWord(PQWord(P)^));
29.         I:=8;
30.         if Result = -1 then goto ScanIt;
31.       end;
32.     end;
33.  If Result<>-1 THen Inc(Result, Added*8);
34. end;
35.  
36. function FirstItemCardinality<T>(var aSet): integer; inline;
37. begin
38.   Result := BigBsf(aSet, Sizeof(T));
39. end;
40.  
41. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
42. begin
43.   Caption := FirstItemCardinality<TshiftState>(Shift).Tostring;
44. end;                                                  
45.  

I prefer to call a base function because this way it does not generate a different set of code for each size.

You can insert the type check if you please but this is to show how I would scan the bits if I were concerned about speed. But either way, I prefer code size reduction, which ever favors the moment.

Jamie