Index vom x-tem gesetztem Bit

[TBx]

Magst Du uns einmal darüber aufklären, wofür Du diese Funktion brauchst?
Mir fällt da so spontan kein Anwendungsfall für ein.

[Uwe Raabe]

Probier mal

Delphi-Quellcode:

mask := Bitmask(0,5,false);

[Maekkelrajter]

Zitat:

Zitat von calibra301 (Beitrag 1466134)

Beispiel: 42 = Binär 00101010, suche das fünfte gesetzte Bit von rechts.
Sind ja nur 3 Bit gesetzt also vorne wieder anfangen.
Ergebnis wäre dann 8

Ah jetzt ja! :idea: Jetzt habe ich wohl endlich verstanden, was du meinst mit: suche das fünfte gesetzte Bit von rechts
Dann kann man die Funktion aber auch deutlich vereinfachen: Der Unfug mit dem 'Richtungswechsel' kann entfallen und es können 32-Bit Parameter und Variablen verwendet werden.
Und Uwe Raabes Hinweis ist auch berücksichtigt. :wink:

Delphi-Quellcode:

Function Bitmask(Value,Position: cardinal):cardinal;
var i,len: Integer;
     mask, Bitcounter: Cardinal;
begin
  result:= 0;
  If value <> 0 Then
  begin
    Bitcounter:= 0;
    len:= (sizeof(value) * 8); // Anzahl der Bits
    while Bitcounter <> Position do
    begin
      for i:= 0 to len - 1 do
      begin
        mask:= (1 shl i);
        If value and mask <> 0 Then inc(Bitcounter);
        if Bitcounter = Position then
        begin
          result:= Mask;
          break;
        end;
      end;
    end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  mask: Byte;
begin
  mask := Bitmask(42,5);
  Showmessage('Das '+inttostr(5)+'. Bit ist an Stelle ' + inttostr(mask));
end;

Auch ich grüble allerdings schon die ganze Zeit über die Frage, wozu das Ganze gut sein soll?? :shock:

Gruß LP

[Uwe Raabe]

Ich will auch mal:

Delphi-Quellcode:

Function Bitmask(Value, Position: Cardinal): Cardinal;
var
  i: Integer;
  Bitcounter: Cardinal;
  valSet: TIntegerSet;
begin
  result := 0;
  valSet := TIntegerSet(Value);
  If valSet <> [] Then
  begin
    Bitcounter := 0;
    while Bitcounter < Position do
    begin
      for i in valSet do
      begin
        inc(Bitcounter);
        if Bitcounter = Position then
          Exit(1 shl i);
      end;
    end;
  end;
end;

[Uwe Raabe]

Und hier noch eine etwas veränderte Version für Delphi 10.4:

Delphi-Quellcode:

Function Bitmask(Value, Position: Cardinal): Cardinal;
var
  i: Integer;
  Bitcounter: Cardinal;
  cntOfBitsSet: Integer;
  valSet: TIntegerSet;
begin
  result := 0;
  cntOfBitsSet := CountPopulation32(value);
  If (cntOfBitsSet > 0) and (Position > 0) Then
  begin
    if cntOfBitsSet < Position then
      Position := ((Position - 1) mod cntOfBitsSet) + 1;
    valSet := TIntegerSet(Value);
    Bitcounter := Position;
    for i in valSet do
    begin
      dec(Bitcounter);
      if Bitcounter = 0 then
        Exit(1 shl i);
    end;
  end;
end;

[Maekkelrajter]

Chapeau!
So sieht der Unterschied zwischen einem 'Master Developer' und einem dilettierenden Autodidakten aus! :oops:

Erst vor ein paar Jahren, als wieder kostenlose Delphi-Versionen verfügbar waren, hatte ich den Schritt von Delphi 4 zu Delphi 10 gewagt. Alle die schönen Features der modernen Delphi-Versionen, die die Arbeit erleichtern und effizienteren, kompakteren oder auch eleganteren Programmcode ermöglichen, finde ich leider meistens nur per Zufall oder eben durch Beispiele (s. o.)

Gruß LP

[einbeliebigername]

Hallo,

ich will auch mitspielen. Habe gleich zwei Varianten. Leider kennt Delphi die Operatoren ROL und ROR nicht. Ich glaube Pascal hatte die.

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

{$IFOPT Q+}{$DEFINE OVERFLOWCHECKSON}{$ENDIF}
{$Q-}
function Rol(const aValue: Byte; const aN: Integer): Byte; //inline;
begin
  Result:= ((aValue shl (aN and 7)) and $FF) or (aValue shr (8- (aN and 7)));
end;

function Ror(const aValue: Byte; const aN: Integer): Byte; //inline;
begin
  Result:= (aValue shr (aN and 7)) or ((aValue shl (8- (aN and 7))) and $FF);
end;
{$IFDEF OVERFLOWCHECKSON}{$Q+}{$ENDIF}

function ValueOfNthSetBitV1(aValue: Byte; aN: UInt64): Byte;
begin
  if aValue= 0 then
    raise Exception.Create('Fehlermeldung');
  Result:= 0;
  while aN> 0 do
  begin
    if Result= 0 then
      Result:= 1
    else
      Result:= Rol(Result, 1);
    if aValue and 1<> 0 then
      Dec(aN);
    aValue:= Ror(aValue, 1);
  end;
end;

function ValueOfNthSetBitV2(const aValue: UInt64; const aValueBitWidth: Byte; const aN: UInt64): Byte;
var
  vTmp: Array[0..63] of UInt64;
begin
  if aValueBitWidth= 0 then
    raise Exception.Create('Fehlermeldung');
  var vBitCount: Byte := 0;
  for var vI: Integer := 0 to aValueBitWidth- 1 do
  begin
    var vBit: UInt64 := 1 shl vI;
    if (aValue and vBit)<> 0 then
    begin
      vTmp[vBitCount]:= vBit;
      Inc(vBitCount);
    end;
  end;
  if vBitCount= 0 then
    raise Exception.Create('Fehlermeldung');
  Result:= vTmp[(aN- 1) mod vBitCount];
end;

begin
  try
    WriteLn(Format('ValueOfNthSetBitV1(42, 3)= %d', [ValueOfNthSetBitV1(42, 3)]));
    WriteLn(Format('ValueOfNthSetBitV1(42, 5)= %d', [ValueOfNthSetBitV1(42, 5)]));
    WriteLn(Format('ValueOfNthSetBitV2(42, 3)= %d', [ValueOfNthSetBitV2(42, 8, 3)]));
    WriteLn(Format('ValueOfNthSetBitV2(42, 5)= %d', [ValueOfNthSetBitV2(42, 8, 5)]));
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

[samso]

Sehr schöne Vorschläge :-D. Bevor jetzt gleich die Lösung via Cloud-Computing kommt - back to the roots:

Delphi-Quellcode:

program Project5;

uses
  SysUtils;

function CheckBitAsm(const Value, BitNumber: Integer): Integer;
asm
  or    Value,Value
  jz    @exit
  cmp   BitNumber,0
  jle   @exit
  mov   ecx,1
@loop:
  test  Value, ecx
  jz    @next
  dec   BitNumber
  jz    @ready
@next:
  rol   ecx,1
  jmp   @loop
@ready:
  mov   eax, ecx
  ret
@exit:
  xor   eax,eax
  ret
end;

begin
  try
// Test
    if CheckBitAsm(42, 3) = 32 then
      writeln('Test 3 - ok');
    if CheckBitAsm(42, 5) = 8 then
      writeln('Test 4 - ok');
    readln;
  except
    on E: Exception do
      writeln(E.ClassName, ': ', E.Message);
  end;

Natürlich nicht ernst gemeint!

[Uwe Raabe]

Zitat:

Zitat von samso (Beitrag 1466186)

Natürlich nicht ernst gemeint!

Glück gehabt. Ich hätte sonst nämlich gleich nach den Lösungen für Win64, MacOS, Android, iOS und Linux mit ihren jeweiligen Derivaten gefragt 8-)

[Andreas13]

Zitat:

Zitat von einbeliebigername (Beitrag 1466182)

Delphi-Quellcode:

  
…
  if aValueBitWidth= 0 then
    raise Exception.Create('Fehlermeldung');
  var vBitCount: Byte := 0;
  for var vI: Integer := 0 to aValueBitWidth- 1 do
  begin
    var vBit: UInt64 := 1 shl vI;
    if (aValue and vBit)<> 0 then 
&#8230;

Sorry, aber Deine Lösung läßt sich (unter XE5) (noch?) nicht kompilieren. Sind die Variablen-Deklarationen innerhalb der For-Schleife unter XE8 schon zulässig oder sind die Zeilen nur beim Hineinkopieren verrutscht?
Danke & Gruß, Andreas