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 mask := Bitmask(0,5,false);

[Maekkelrajter]

Zitat von calibra301:

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! 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.

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??

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!

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 . 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 von samso:

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

[Andreas13]

Zitat von einbeliebigername:

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 
…

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