Spielerei: BitArray für Nullen und Einsen

[NicTheQuick]

Für alle, die etwas Speicherplatz sparen wollen und wenn es nur um Einsen
oder Nullen geht:

Code: Alles auswählen

;Info: BitArray

Procedure DimBitArray(Size.l) ;Allokiert den Speicher für ein neues Array, Result: Pointer
  Size + 1
  If Size > 0
    If Size & 7
      ProcedureReturn AllocateMemory(Size >> 3 + 1)
    Else
      ProcedureReturn AllocateMemory(Size >> 3)
    EndIf
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure ReDimBitArray(Size.l, *Array) ;Ändert die Größe eines Arrays, Result: Neuer Pointer
  Size + 1
  If Size > 0
    If Size & 7
      ProcedureReturn ReAllocateMemory(*Array, Size >> 3 + 1)
    Else
      ProcedureReturn ReAllocateMemory(*Array, Size >> 3)
    EndIf
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure FreeBitArray(*Array) ;Gibt den Speicher wieder frei
  If *Array
    FreeMemory(*Array)
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Macro SwapBit(Array, Bit) ;Wechselt den Zustand eines Bits zwischen 0 und 1
  PokeB(Array + Bit >> 3, PeekB(Array + Bit >> 3) ! (1 << (Bit & 7)))
EndMacro

Macro GetBit(Array, Bit) ;Gibt ein Bit zurück
  ((PeekB(Array + Bit >> 3) >> (Bit & 7)) & 1)
EndMacro

Macro SetBit(Array, Bit, state) ;Setzt ein Bit (nur 0 oder 1 benutzen!)
  PokeB(Array + Bit >> 3, (PeekB(Array + Bit >> 3) & ~(1 << (Bit & 7))) | (state << (Bit & 7)))
EndMacro

Und hier noch ein Beispielcode für Primzahlen. Erkennt bei mir in 26
Sekunden alle Primzahlen zwischen 0 und 134.217.728.

Code: Alles auswählen

Define MaxPrim.l, *prim, time.l, i.l, start.l, a.l

MaxPrim = 1024 * 1024 * 128

*prim = DimBitArray(MaxPrim) ;Allokiert 16 MB

time = ElapsedMilliseconds()
start = 2 ;erste Primzahl
While start < MaxPrim
  Debug start ;gib primzahl aus
  i = start * 2
  While i < MaxPrim ;Markiere alle Vielfache von start
    SetBit(*prim, i, 1)
    i + start
  Wend
  Repeat ;Suche nächste Primzahl
    start + 1
  Until GetBit(*prim, start) = 0
Wend

time = ElapsedMilliseconds() - time

MessageRequester("Zeit", "Zeit für alle Primzahlen zwischen 0 und " + Str(MaxPrim) + ":" + Chr(13) + Str(time) + " ms")

;0 und 1 sind keine Primzahlen
For a = 2 To MaxPrim - 1
  If GetBit(*prim, a) = 0 ;Alle, die nicht markiert sind, sind Primzahlen
    Debug a
  EndIf
Next

FreeBitArray(*prim) ;Gibt Speicher wieder frei

Viel Spaß damit!

Wenn es Optimierungen gibt, her damit!

[Kaeru Gaman]

nätt

wirklich interessant und angenehm zu lesen,
bringt die gehirnwindungen in schwung am frühen morgen.


zu
> ;Setzt ein Bit (nur 0 oder 1 benutzen!)
falls du einen unsupported-trick nutzen möchtest...

wenn du "state" ersetzt durch

Code: Alles auswählen

(0 Or (state <> 0))

schaltest du alle zahlen ungleich Null auf 1...
aber wie gesagt, das is nur ein trick, und es gibt keine garantien für zukünftige funktionalität...


PS:
wenn jetzt PB ein kleines bißchen mehr wie C wäre, dann könnte man sowas machen:

Code: Alles auswählen

SetBit( SpriteStateArray, SpriteNr, ( SpritePointers(SpriteNr) = CreateSprite( #PB_Any, 256, 256 ) ) )

[Shardik]

Für alle, die etwas Speicherplatz sparen wollen und wenn es nur um Einsen oder Nullen geht

Sehr schönes Beispiel für unlimitierte Bit-Arrays!!! Ich habe vor geraumer Zeit ein ähnliches Beispiel geschrieben, das allerdings nur mit einem Long-Wert zur Speicherung von 32 Bits arbeitet, dafür aber optimiert in Assembler:

Code: Alles auswählen

Procedure ClearFlag(FlagBit.L)
  !MOV EAX,[ESP+4]
  !BTR DWORD[v_Flags],EAX
EndProcedure


Procedure SetFlag(FlagBit.L)
  !MOV  EAX,[ESP+4]
  !BTS  DWORD[v_Flags],EAX
EndProcedure


Procedure GetFlag(FlagBit.L)
  !PUSH EBX
  !XOR  EAX,EAX
  !MOV  EBX,DWORD[ESP+8]
  !BT   DWORD[v_Flags],EBX
  !JNC  $+3
  !INC  EAX
  !POP  EBX
  ProcedureReturn 
EndProcedure


Global Flags.L

i.L

Debug "Test ClearFlag() - alle Flags der Reihe nach löschen"
Flags = $FFFFFFFF
Debug "Flags = " + Hex(Flags)

For i = 0 To 31
  ClearFlag(i)
  Debug "Flags = " + RSet(Hex(Flags), 8, "0")
Next i

Debug "-----"
Debug "Test SetFlag() - alle Flags der Reihe nach setzen"
Flags = 0
Debug "Flags = " + RSet(Hex(Flags), 8, "0")

For i = 0 To 31
  SetFlag(i)
  Debug "Flags = " + RSet(Hex(Flags), 8, "0")
Next i

Debug "-----"
Debug "Test GetFlag() - alle Flags der Reihe nach testen"

Flags = $C0000013

Debug "Flags = " + Hex(Flags)

For i = 0 To 31
  Debug "Flag " + Str(i) + " = " + Str(GetFlag(i))
Next i

Der Vorteil dieses Verfahrens besteht darin, daß man bis zur 32 Flags in einem Wert in einer Konfigurationsdatei (z.B. Ini-Datei) sehr bequem speichern und wieder einlesen kann. Ich benutze z.B. folgende Flags für einen von mir programmierten FTP-Client:

Code: Alles auswählen

Enumeration
  #DownloadMayOverwriteFile
  #DownloadStripEOL
  #EOLCharIsCRLF              ; 0 = LF, 1 = CRLF
  #RemoveTrailingBlanks
  #TransferModeIsASCII        ; 0 = Binary, 1 = ASCII
  #UploadMayOverwriteFile
  #PCCharSetIsASCII           ; 0 = ANSI, 1 = ASCII
  #DownloadAppendsToFile
  #UploadMayOverwriteMember
  #UploadAppendsToFile
  #UploadAppendsToMember
EndEnumeration

und kann dann sehr bequem über die Bit-Konstantennamen auf das entsprechende Flag zugreifen:

Code: Alles auswählen

If GetFlag(#RemoveTrailingBlanks) = #True
  ...
End If

Außerdem kann ich in einer erweiterten Programmversion noch weitere Konstanten in die Enumeration hinten anfügen, solange deren Default-Wert 0 ist, ohne daß schon bestehende Ini-Dateien unbrauchbar werden (die Abwärtskompatibilität ist für meine Anwender sehr wichtig!). In einer Übertragungsliste meines FTP-Programms kann der Anwender viele verschiedene Dateitransfers speichern, die unterschiedlichste Parameter aufweisen können, z.B. die erste Datei überschreibt die Server-Datei, die nächste Datei wird an eine andere Server-Datei angehängt, oder nach einem Upload erfolgt direkt ein Download usw. Für jede vom Anwender vorgegebene Übertragung in der abgespeicherten Übertragungsliste braucht so immer nur ein Long-Wert mit den Flags gespeichert werden.