Binärdarstellung einer Zahl mit einer einzigen Stringallokation

[BUG]

Hallo,

ausgehend von diesem Thread habe ich mir überlegt, wie man eine Umwandlung in Binärdarstellung ohne Änderung der Länge des Strings hinbekommen könnte (ohne die Umrechnung einfach zweimal zu machen).

Herausgekommen ist dann dieses Monster, das die Länge der Binärdarstellung mit binärer Suche findet :mrgreen:

Delphi-Quellcode:

function intToBin(x: cardinal) : string;
var
 offset: integer;
 nextOffset: integer;
 lbits: integer;
 i: integer;
begin
  lbits := 0;
  offset := sizeof(cardinal)*8;
  // binäre Suche der richtige Größe
  while (offset > 0) and (cardinal(1 shl (lbits+offset-1)) > x) do
  begin // Maske kann verkleinert werden
    nextOffset := offset div 2; // immer kleiner
    if ((high(cardinal) shl (lbits + nextOffset)) and x) = 0 then
    begin
      // Maske der nicht von lbits + nextOffset abgedeckten Bits überdeckt keine Bits von x
      // -> Wir kennen bessere obere Schranke :)
      offset := nextOffset;
    end else begin
      // Wir haben eine bessere untere Schranke :)
      lbits := lbits + nextOffset + 1; // lbits + nextOffset ist definitiv zu klein
      offset := offset - nextOffset - 1; // offset so anpassen, dass lbit + offest gleich bleibt
    end;
  end;
  lbits := lbits + offset;
  if lbits = 0 then inc(lbits); // mindestens eine Stelle wollen wir haben
  setLength(intToBin, lbits);
  // jetzt nur noch das eigentliche Umwandeln
  for i := 0 to lbits-1 do
  begin
    if (x and 1) = 0
      then intToBin[lbits-i] := '0'
      else intToBin[lbits-i] := '1';
    x := x shr 1;
  end;
end;

Dann mir eingefallen, dass das vermutlich viel schneller geht:

Delphi-Quellcode:

function intToBin(x: cardinal) : string;
const
  maxLength = sizeof(cardinal)*8;
var
  buffer: array[0..maxLength-1] of char;
  digits: integer;
begin
  digits := 0;
  repeat
    inc(digits);
    if (1 and x) = 0
      then buffer[maxLength-digits] := '0'
      else buffer[maxLength-digits] := '1';
    x := x shr 1;
  until (x = 0);
  setLength(intToBin, digits);
  move(&buffer[maxLength-digits], &intToBin[1], sizeof(char)*digits);
end;

Auch hier wird der Heap nur einmal gequält, dafür aber ein Buffer auf dem Stack angelegt.


Damit ich das nicht völlig umsonst geschrieben habe, könnt ihr es jetzt angucken und als Übung dafür nehmen, verworrenen Code zu lesen. Kommentare sind erlaubt :wink:

[Medium]

Stringlänge := Ceil(Lb(Zahlenwert)) ;)

Delphi-Quellcode:

var
  i, k, len: Integer;
begin
  k := 1;
  if x>0 then
  begin
    len := Ceil(Lb(x));
    SetLength(result, len);
    dec(k);
  else
  if x<0 then
  begin
    len := Ceil(Lb(x))+1;
    SetLength(result, len);
    result[k] := '-';
    x := -x;
  end
  else
  begin
    result := '0';
    Exit;
  end;

  for i := 1 to Length(result)-k do
    result[i+k] := Chr(((x shr (len-i+1)) and 1)+Ord('0'));
end;

Ungetestet und nur für 8-Bit Strings. Möglich, dass der Laufindex noch versetzt ist, aber ich will ins Bett :)

[Furtbichler]

Zitat:

Zitat von BUG (Beitrag 1167831)

und als Übung dafür nehmen, verworrenen Code zu lesen. Kommentare sind erlaubt :wink:

Der Code ist gar nicht so verworren, nur die Herleitung der Lösung ein klassisches Beispiel für "von Hinten durch die Brust ins Auge".

[DeddyH]

Wenn die Ausgabe immer in der tatsächlichen Bitbreite erfolgen soll:

Delphi-Quellcode:

function IntToBin(AInt: Cardinal): string;
const
  BITSPERBYTE = 8;
  BITCHARS: array[Boolean] of char = ('0', '1');
var
  BitPos: byte;
  CurrentBit: Cardinal;
begin
  SetLength(Result, SizeOf(AInt) * BITSPERBYTE);
  CurrentBit := 1;
  for BitPos := Length(Result) downto 1 do
    begin
      Result[BitPos] := BITCHARS[(AInt and CurrentBit) = CurrentBit];
      CurrentBit := CurrentBit shl 1;
    end;
end;

[Aphton]

Die Anzahl der Stellen kann man doch einfach so ermitteln:

Delphi-Quellcode:

var
  digits: Integer;
begin
  digits := ceil(log(Value)/log(2));
  {...}
end;

Oder geht es gar nicht darum?

Delphi-Quellcode:

function IntToBin(Value: Integer): String;
var
  i: Integer;
  j: Double;
const
  BitValues: Array[Boolean] of Char = ('0', '1');
begin
  if Value = 0 then
    Result := '0'
  else
  begin
    j := Log2(Value);
    i := Ceil(j);
    if IsZero(Frac(j)) then inc(i);
    SetLength(Result, i);
    while i > 0 do
    begin
      Result[i] := BitValues[(Value and 1) = 1];
      Value := Value shr 1;
      dec(i);
    end;
  end;
end;

[Medium]

Doch, siehe meinen Beitrag. Und Furtis :)

[jfheins]

Also diese Aufgabenstellung lässt sich sicher wieder auf 5 Seiten auswalzen ^^

Falls der Code einfach zu verstehen sein soll, würde ich die Lösung mit dem Logarithmus bevorzugen.

Delphi-Quellcode:

Result := Ceil(Math.Log2(Value));

Wenn das zu langsam ist, könntest du es mit der FPU versuchen:
1. Gibt es wohl einen Opcode für den Log2: FYL2X
2. Schreibe die Zahl in ein FPU Register und lese (durch einen Bitshift oder so) den Exponenten aus. (Trick 17 ^^)

[gammatester]

Noch ein Vorschlag, das Prinzip: Ermittele das höchste gesetzte Bit, allokiere den String und verarbeite die restlichen Bits.

Delphi-Quellcode:

function IntToBin(x: cardinal): string;
var
  i,n: integer;
  m: cardinal;
begin
  if x=0 then Result := '0'
  else begin
    {Teil 1: Bestimme höchstes gesetztes Bit}
    m := cardinal($80000000);
    n := 32;
    while m and x = 0 do begin
      dec(n);
      m := m shr 1;
    end;
    {Teil 2: Allokieren und Bits abarbeiten, n>0 da x<>0!}
    Setlength(Result,n);
    for i:=1 to n do begin
      if m and x <> 0 then Result[i] := '1'
      else Result[i] := '0';
      m := m shr 1;
    end;
  end;
end;

[Amateurprofi]

warum einfach und schnell wenns auch kompliziert und langsam geht?

Delphi-Quellcode:

FUNCTION IntToBin(v:cardinal):string;
FUNCTION NeededLength(v:cardinal):integer;
asm
      bsr   eax,eax
      jnz   @1
      xor   eax,eax
@1:   add   eax,1
end;
var i:integer;
begin
   i:=NeededLength(v);
   SetLength(result,i);
   repeat
      result[i]:=Chr(Ord('0') or v and 1);
      dec(i);
      v:=v shr 1;
   until i=0;
end;

[BUG]

Zitat:

Zitat von gammatester (Beitrag 1167897)

Noch ein Vorschlag, das Prinzip: Ermittele das höchste gesetzte Bit, allokiere den String und verarbeite die restlichen Bits.

Das ist das Prinzip (fast) aller hier vorgestellten Codes :mrgreen:

Mein Gedanken für die binäre Suche war, das man nicht alle Bits zweimal angucken muss. Der Aufwand für einen Schleifendurchlauf ist vielleicht etwas zu hoch.

Zitat:

Zitat von jfheins (Beitrag 1167884)

Gibt es wohl einen Opcode für den Log2 FYL2X

Ich würde doch hoffen, das lb den benutzt.

Wenn ich es einsetzen müsste, würde ich wohl den Vorschlag von Amateurprofi wählen: keine Gleitkommazahlen und ohne Umwege. Aber kein pures Delphi/Pascal :stupid:

[gammatester]

Zitat:

Zitat von BUG (Beitrag 1167916)

Mein Gedanken für die binäre Suche war, das man nicht alle Bits zweimal angucken muss. Der Aufwand für einen Schleifendurchlauf ist vielleicht etwas zu hoch.
...
Wenn ich es einsetzen müsste, würde ich wohl den Vorschlag von Amateurprofi wählen: keine Gleitkommazahlen und ohne Umwege. Aber kein pures Delphi/Pascal :stupid:

Wahrscheinlich hast Du nicht genau hingesehen, aber bei meinem Code werden die Bits nur einmal angesehen (bis auf das höchste, aber das könnte man auch noch wegoptimieren).

Im Übrigen macht Amateurprofis NeededLength auch nichts wesentlich anderes, und ich bezweifele, ob ein Funktionsaufruf und langsames bsr schneller sind. Weiter kann man natürlich auch die finale Schleife rückwarts durchlaufen, hier also der kombinierte Code in Pur-Pascal:

Delphi-Quellcode:

function IntToBin(x: cardinal): string;
var
  i,n: integer;
  m: cardinal;
begin
  if x=0 then Result := '0'
  else begin
    {Teil 1: Bestimme höchstes gesetztes Bit}
    m := cardinal($80000000);
    n := 32;
    while m and x = 0 do begin
      dec(n);
      m := m shr 1;
    end;
    {Teil 2: Allokieren und Bits abarbeiten, n>0 da x<>0!}
    Setlength(Result,n);
    for i:=n downto 1 do begin
      Result[i] := Chr(Ord('0') or (x and 1));
      x := x shr 1;
    end;
  end;
end;

[p80286]

wie wäre es hiermit?

Delphi-Quellcode:

fuction GetLengthofBinString(z:longword):integer;
  i : integer;
begin
  result:=0;
  for i:=0 to 31 do
    if (z and (1 shl i))<>0 then result:=i+1;
end;

Gruß
K-H

[gammatester]

Damit wird ja schon allein zur Längenbestimmung jedes Bits angesehen!

[BUG]

Zitat:

Zitat von gammatester (Beitrag 1167920)

Wahrscheinlich hast Du nicht genau hingesehen, aber bei meinem Code werden die Bits nur einmal angesehen (bis auf das höchste, aber das könnte man auch noch wegoptimieren).

Stimmt, hast recht :thumb:

Zitat:

Zitat von gammatester (Beitrag 1167920)

Im Übrigen macht Amateurprofis NeededLength auch nichts wesentlich anderes,

Wie gesagt, die machen alle das gleiche.

Zitat:

Zitat von gammatester (Beitrag 1167920)

und ich bezweifele, ob ein Funktionsaufruf und langsames bsr schneller sind.

Bei kleinen Zahlen könnte es schneller sein.
Bei großen Zahlen muss der Code ja auch alle Bits durchgehen (siehe oben).

[himitsu]

Zitat:

Zitat von gammatester (Beitrag 1167925)

Damit wird ja schon allein zur Längenbestimmung jedes Bits angesehen!

Wobei BSR auch nicht so toll sein soll.
Zumindestens für 32 Bit war es so (64 weiß ich nicht), aber da gab es letzes Jahr einen Thread dazu, wo ich dieses BSR verwendete.

Delphi-Quellcode:

function GetLengthofBinString(z: LongWord): LongInt; inline:

function GetLengthOfBinString(Value: LongWord): LongInt;
begin
  Result := 32;
  while (Result >= 0) and (LongInt(Value) >= 0) do begin
    Dec(Result);
    Value := Value shl 1;
  end;
end;

Mit etwas Glück macht der Compiler daraus einen Code, welcher nur 2 Register belegt und komplett innerhalb der Register arbeitet.

Oder man nutzt eben doch Assembler.



klar, man könnte jetzt noch über eine Bitmaske mehrere Bits prüfen.
z.B. jedes Byte einzeln, aber ob das immer was bringt?

Delphi-Quellcode:

function GetLengthOfBinString(Value: LongWord): LongInt;
begin
  if Value = 0 then 
    Exit(0);
  Result := 32;
  if Value and $FFFF0000 = 0 then begin
    Result := 16;
    Value := Value shl 16;
  end;
  while (Result >= 0) and (LongInt(Value) >= 0) do begin
    Dec(Result);
    Value := Value shl 1;
  end;
end; 

//oder

function GetLengthOfBinString(LongWord: LongWord): LongInt;
begin
  if Value = 0 then 
    Exit(0);
  Result := 32;
  while (Result >= 0) and (Value and $FF000000 = 0) do begin
    Dec(Result, 8);
    Value := Value shl 8;
  end;
  while (Result >= 0) and (LongInt(Value) >= 0) do begin
    Dec(Result);
    Value := Value shl 1;
  end;
end;

Die Pascal-Variante hätte den Vorteil derPlattformunabhängigkeit und sie könnte man auch für 64 Bit anpassen.
32 = SizeOf(NativeInt) * 8
LongInt = NativeInt
LongWord = LongWord
$FF000000 = ($FF shl (SizeOf(NativeInt) - 1) * 8)
usw.

[Iwo Asnet]

Also ich wäre schwer dafür, für die Bitlänge eine Lookuptabelle zu nehmen. Das könnte noch schneller sein. Gut, der Speicherverbrauch ist suboptimal, aber darum geht es hier nichtm, denn die Aufgabenstellung besagt:
1. Jedes Bit nur einmal anschauen (wegen der bit abrasion, is klar) und
2. soll der String soll auch nur 1x alloziiert werden. Vermutlich das schädlich für den Speicher, ich tippe auf memory rotting, wegen dem fehlenden garbage collector

[himitsu]

Wegen Speicher ... macht es doch so wie IntToStr oder Format?

ein

Delphi-Quellcode:

array[0..31] of Char

als Puffer auf'm Stack,
dann einmal die Zeichen berechnen und den Puffer befüllen,
gleichzeitig werden die Bits automatisch gezählt
und zum Schluß ein SetString, wo nur einmal Speicher allociert wird.
:stupid:

[Iwo Asnet]

Spielverderber.

[BUG]

Zitat:

Zitat von himitsu (Beitrag 1167940)

ein

Delphi-Quellcode:

array[0..31] of Char

als Puffer auf'm Stack,
dann einmal die Zeichen berechnen und den Puffer befüllen,
gleichzeitig werden die Bits automatisch gezählt
und zum Schluß ein SetString, wo nur einmal Speicher allociert wird.
:stupid:

Guck mal in den ersten Beitrag :tongue:

So daneben lag ich mit der binären Suche für das wohl trotzdem nicht:

Zitat:

Zitat von http://coding.derkeiler.com/Archive/Assembler/comp.lang.asm.x86/2005-04/msg00283.html

K7 - microcoded binary-search, runs in constant 7-8 cycles

Das blr so langsam sein kann, hatte ich nicht vermutet.

[Amateurprofi]

Zitat:

Zitat von gammatester (Beitrag 1167920)

Im Übrigen macht Amateurprofis NeededLength auch nichts wesentlich anderes, und ich bezweifele, ob ein Funktionsaufruf und langsames bsr schneller sind.

Hallo gammatester,

vielleicht solltest du nicht nur bezweifeln sondern prüfen.

Ich habe mal mit den Werten 0, 2^0..31 getestet.

Die nachstehende Tabelle zeigt von links nach rechts folgende Daten

1) Der Wert der umgewandelt wurde.
2) CPU-Ticks für deine IntToBin.
3) CPU-Ticks für meine IntToBin.
4) CPU-Ticks für deine Ermittlung der benötigten Länge.
5) CPU-Ticks für meine Ermittlung der benötigten Länge.

Mein zusätzlicher Funktionsaufruf und das so langsame "bsr" ist im (Vergleich zu deiner Methode) genau so schnell bis 7 Mal so schnell.

Code:

         0 238 110 /   50  50
         1 568 110 /  374  50
         2 484 136 /  358  50
         4 484 152 /  340  50
         8 492 178 /  330  50
        16 494 204 /  322  50
        32 500 220 /  306  50
        64 518 238 /  288  50
       128 520 264 /  280  50
       256 534 288 /  262  50
       512 544 314 /  246  50
      1024 552 340 /  238  50
      2048 568 356 /  228  50
      4096 578 382 /  212  50
      8192 586 408 /  204  50
     16384 594 432 /  188  52
     32768 604 450 /  170  50
     65536 612 476 /  162  50
    131072 630 502 /  144  50
    262144 706 526 /  136  50
    524288 714 612 /  128  50
   1048576 730 630 /  110  50
   2097152 730 670 /  102  50
   4194304 748 680 /   92  50
   8388608 756 714 /   84  50
  16777216 782 730 /   84  50
  33554432 782 748 /   68  50
  67108864 792 774 /   68  50
 134217728 808 798 /   60  50
 268435456 824 826 /   58  50
 536870912 840 850 /   58  50
1073741824 858 866 /   50  58
2147483648 892 884 /   50  50

[Amateurprofi]

Zitat:

Zitat von himitsu (Beitrag 1167940)

Wegen Speicher ... macht es doch so wie IntToStr oder Format?

ein

Delphi-Quellcode:

array[0..31] of Char

als Puffer auf'm Stack,
dann einmal die Zeichen berechnen und den Puffer befüllen,
gleichzeitig werden die Bits automatisch gezählt
und zum Schluß ein SetString, wo nur einmal Speicher allociert wird.
:stupid:

Wirklich schnell ist das aber auch nicht.
Warum?:
Man schreibt die Daten in den Puffer und das SetStr kopiert sie dann in den String.
Besser ist, die Länge des Strings zu definieren und dann direkt in den String zu schreiben.

Die beiden nachstehenden Routinen machen das alles recht flink.
Die zweite Routine ist deutlich schneller weil bummelige Shifts vermieden werden und weil vorwärts geschrieben wird.
Die Tabelle zeigt für die Werte 0, 2^0..31 von links nach rechts
- den Wert
- benötigte CPU-Takte für gammatesters Routine (#11)
- dto für meine Routine (#9)
- dto für die erste der untenstehenden Routinen
- dto für die zweite der untenstehenden Routinen

Code:

         0 238 110 126 126
         1 578 110 126 136
         2 476 136 136 126
         4 526 162 144 144
         8 500 186 144 144
        16 502 212 152 144
        32 510 238 160 152
        64 518 262 162 160
       128 526 288 162 160
       256 534 322 170 170
       512 544 340 178 170
      1024 552 364 204 178
      2048 570 390 194 178
      4096 586 408 196 186
      8192 594 442 212 186
     16384 604 466 212 194
     32768 620 484 220 188
     65536 628 518 228 204
    131072 630 536 230 204
    262144 646 562 238 204
    524288 730 646 246 204
   1048576 738 672 246 204
   2097152 740 704 272 212
   4194304 756 722 262 220
   8388608 782 756 272 220
  16777216 790 790 288 228
  33554432 806 798 280 228
  67108864 806 824 296 228
 134217728 832 850 296 238
 268435456 850 892 314 246
 536870912 884 900 306 246
1073741824 892 926 314 254
2147483648 908 952 322 254

Delphi-Quellcode:

FUNCTION IntToBin3(v:Cardinal):string;
asm
            push  ebx
            push  eax                        // V
            push  edx                        // @Result
            // Benötigte Länge in EBX
            xor   ebx,ebx
            bsr   ebx,eax                    // Länge-1
            lea   ebx,[ebx+1]                // Länge
            // Result löschen
            mov   eax,edx
            call  System.@UStrClr
            // Kurzfassung von NewUniCodeString
            lea   eax,[ebx*2+12+2]           // Länge*2 + SizeOf(StrRec) + 2
            call  System.@GetMem
            mov   edx,DefaultUnicodeCodePage
            and   edx,$FFFF                  // nur LoWord
            or    edx,$20000                 // elemSize
            mov   [eax],edx                  // StrRec.codePage und .elemSize
            mov   [eax+4],1                  // StrRec.refCnt
            mov   [eax+8],ebx                // StrRec.Length
            lea   eax,[eax+12]               // @NewString
            // @NewString in Result stellen
            pop   edx
            mov   [edx],eax                  // Result
            // Ende 00 ans Stringende schreiben
            lea   eax,[eax+ebx*2]            // @NewString[Len+1]
            mov   word [eax],0               // Str-Terminator
            // V als Binärstring in Result schreiben
            pop   edx                        // V
@Loop:      lea   eax,[eax-2]
            shr   edx,1
            setc  bl
            lea   ebx,[ebx+$30]
            mov   [eax],bx
            jne   @Loop
            pop   ebx
end;

Delphi-Quellcode:

FUNCTION IntToBin4(v:Cardinal):string;
asm
            push  ebx
            push  eax                        // V
            push  edx                        // @Result
            // Benötigte Länge in EBX
            xor   ebx,ebx
            bsr   ebx,eax                    // Länge-1
            lea   ebx,[ebx+1]                // Länge
            // Result löschen
            mov   eax,edx
            call  System.@UStrClr
            // Kurzfassung von NewUniCodeString
            lea   eax,[ebx*2+12+2]           // Länge*2 + SizeOf(StrRec) + 2
            call  System.@GetMem
            mov   edx,DefaultUnicodeCodePage
            and   edx,$FFFF                  // nur LoWord
            or    edx,$20000                 // elemSize
            mov   [eax],edx                  // StrRec.codePage und .elemSize
            mov   [eax+4],1                  // StrRec.refCnt
            mov   [eax+8],ebx                // StrRec.Length
            lea   eax,[eax+12]               // @NewString
            mov   word[eax+ebx*2],0          // Str-Terminator
            // @NewString in Result stellen
            pop   edx
            mov   [edx],eax                  // Result
            // V als Binärstring in Result schreiben
            pop   edx                        // V
            lea   eax,[eax+ebx*2]            // Hinter String
            neg   ebx
            lea   ecx,[ebx+32]               // ( v so nach links verschieben,
            shl   edx,cl                     //   Nit 31 steht )
            jmp   @Entry
@Loop:      add   edx,edx
@Entry:     sets  cl                         // Sign Flag in BL
            lea   ecx,[ecx+$30]              // in Char wandeln
            mov   [eax+ebx*2],cx             // Char ib String schreiben
            add   ebx,1
            jne   @Loop                      // weiter bis edx leer ist
            pop   ebx
end;