Pointer und #PB_Any direkt als MapKey verwenden

[xXRobo_CubeXx]

Ohne debugger etwa 40% schneller, mit debugger etwa 4 mal langsamer

Das ist ganz normal das mit Debugger deutlich langsamer ist. Wenn man Zeit messen möchte immer vorher den Debugger ausschalten!

[mk-soft]

Da ist mir klar. Ging nur um den Vergleich mit debugger.

test-code mit 2048 slots

Code: Alles auswählen

;-TOP

; Comment: Stringkey aus Integer
; Author1: GPI
; Author2: mk-soft
; Date:    31.08.2017

CompilerIf #PB_Compiler_Processor=#PB_Processor_x86
  #_handlemask=$11111111
  #_handleadd= $22222222
  Structure udtXMap
    StructureUnion
      key.i[2]
      CompilerIf #PB_Compiler_Unicode
        s.s{4}
      CompilerElse
        s.s{8}
      CompilerEndIf  
      null.w
    EndStructureUnion
  EndStructure
CompilerElse
  #_handlemask=$1111111111111111
  #_handleadd= $2222222222222222
  Structure udtXMap
    StructureUnion
      key.i[2]
      CompilerIf #PB_Compiler_Unicode
        s.s{8}
      CompilerElse
        s.s{16}
      CompilerEndIf  
      null.w
    EndStructureUnion
  EndStructure
CompilerEndIf

Procedure.s XMap(i)
  Protected r1.udtXMap
  r1\key[0] = (i | #_handlemask)
  r1\key[1] = (i & #_handlemask) | #_handleadd
  ProcedureReturn r1\s
EndProcedure

; ***************************************************************************************

; Comment: Integer Map
; Author: NicTheQuick
; Date:    31.08.2017

DeclareModule MapI2I
   EnableExplicit
   Interface MapI2I
      free.i()
      set.i(key.i, value.i)
      unset.i(key.i)
      get.i(key.i)
      is.i(key.i)
      bucketsUsed.i()
      elements.i()
   EndInterface
   
   Declare newMapI2I(buckets.i)
EndDeclareModule

Module MapI2I
   EnableExplicit
   Structure entry
      key.i
      value.i
      *next.entry      ; Wird zu beginn auf 1 gesetzt um zu signalisieren, dass das Element noch nicht existiert und Speicherplatz zu sparen
   EndStructure
   
   Structure entries
      entry.entry[0]
   EndStructure
   
   Structure table
      *vTable
      buckets.i
      bucketsUsed.i
      elements.i
      *entries.entries
   EndStructure
   
   ; Siehe https://stackoverflow.com/a/12996028/4239139
   CompilerIf SizeOf(Integer) = 4
      Macro hash(x)
         x = ((x >> 16) ! x) * $45d9f3b
         x = ((x >> 16) ! x) * $45d9f3b
         x = (x >> 16) ! x
      EndMacro
   CompilerElse
      Macro hash(x)
         x = (x ! (x >> 30)) * $bf58476d1ce4e5b9
          x = (x ! (x >> 27)) * $94d049bb133111eb
          x = x ! (x >> 31);
      EndMacro
   CompilerEndIf
   
   Procedure newMapI2I(buckets.i)
      Protected *this.table, i.i
      
      If buckets < 1
         ProcedureReturn #False
      EndIf
      
      *this = AllocateStructure(table)
      If Not *this
         ProcedureReturn #False
      EndIf
      
      
      With *this
         \vTable = ?vTable_mapI2I
         \buckets = buckets.i
         \bucketsUsed = 0
         \elements = 0
         \entries = AllocateMemory(SizeOf(entry) * buckets, #PB_Memory_NoClear)
         If Not \entries
            FreeStructure(*this)
            ProcedureReturn #False
         EndIf
         For i = 0 To buckets - 1
            \entries\entry[i]\next = 1
         Next
      EndWith
      
      ProcedureReturn *this
   EndProcedure
   
   Procedure.i free(*this.table)
      Protected i.i, *entry.entry, *nextEntry.entry
      With *this
         For i = 0 To *this\buckets - 1
            If \entries\entry[i]\next <> 1
               *entry = \entries\entry[i]\next
               While *entry
                  *nextEntry = *entry\next
                  FreeMemory(*entry)
                  *entry = *nextEntry
               Wend
            EndIf
         Next
         FreeMemory(\entries)
         FreeStructure(*this)
      EndWith
   EndProcedure
   
   Procedure.i is(*this.table, key.i)
      Protected *entry.entry, bucket.i = key
      hash(bucket)
      bucket % *this\buckets
      *entry = @*this\entries\entry[bucket]
      If *entry\next = 1
         ProcedureReturn #False
      EndIf
      While *entry
         If *entry\key = key
            ProcedureReturn #True
         EndIf
         *entry = *entry\next
      Wend
      
      ProcedureReturn #False
   EndProcedure
   
   Procedure.i get(*this.table, key.i)
      Protected *entry.entry, bucket.i = key
      hash(bucket)
      bucket % *this\buckets
      *entry = @*this\entries\entry[bucket]
      If *entry\next = 1
         ProcedureReturn #False
      EndIf
      While *entry
         If *entry\key = key
            ProcedureReturn *entry\value
         EndIf
         *entry = *entry\next
      Wend
      
      ProcedureReturn #False
   EndProcedure
   
   Procedure.i set(*this.table, key.i, value.i)
      Protected *entry.entry, bucket.i = key, *lastEntry.entry
      hash(bucket)
      bucket % *this\buckets
      *entry = @*this\entries\entry[bucket]
      *lastEntry = *entry
      If *entry\next = 1
         *this\bucketsUsed + 1
      Else
         Repeat
            If *entry\key = key
               *entry\value = value
               *this\elements + 1
               ProcedureReturn *entry
            EndIf
            *lastEntry = *entry
            *entry = *entry\next
         Until Not *entry
      EndIf
      If *lastEntry\next = 1
         *lastEntry\key = key
         *lastEntry\value = value
         *lastEntry\next = 0
         *this\elements + 1
         ProcedureReturn *lastEntry
      Else
         *lastEntry\next = AllocateMemory(SizeOf(entry), #PB_Memory_NoClear)
         If Not *lastEntry\next
            ProcedureReturn #False
         EndIf
         *lastEntry\next\key = key
         *lastEntry\next\value = value
         *lastEntry\next\next = 0
         *this\elements + 1
         ProcedureReturn *lastEntry\next
      EndIf
   EndProcedure
   
   Procedure.i unset(*this.table, key.i)
      Protected *entry.entry, bucket.i = key, *firstEntry.entry, *previousEntry.entry
      hash(bucket)
      bucket % *this\buckets
      *entry = @*this\entries\entry[bucket]
      *firstEntry = *entry
      *previousEntry = *entry
      If *entry\next = 1
         ProcedureReturn #False
      EndIf
      While *entry
         If *entry\key = key
            If *entry = *firstEntry
               If *entry\next = 0
                  ; Der einzige Eintrag der LinkedList soll gelöscht werden
                  *this\bucketsUsed - 1
                  *entry\next = 1
               Else
                  ; Der erste Eintrag der LinkedList soll gelöscht werden und es folgt noch mindestens ein weiterer
                  *entry\key = *entry\next\key
                  *entry\value = *entry\next\value
                  *entry\next = *entry\next\next
               EndIf
               *this\elements - 1
               ProcedureReturn #True
            Else
               ; Der zweite oder einer der nachfolgenden Einträge soll gelöscht werden.
               *previousEntry\next = *entry\next
               FreeMemory(*entry)
               *this\elements - 1
               ProcedureReturn #True
            EndIf
         EndIf
         *previousEntry = *entry
         *entry = *entry\next
      Wend
      
      ProcedureReturn #False
   EndProcedure
   
   Procedure.i bucketsUsed(*this.table)
      ProcedureReturn *this\bucketsUsed
   EndProcedure
   
   Procedure.i elements(*this.table)
      ProcedureReturn *this\elements
   EndProcedure
   
   DataSection
      vTable_mapI2I:
         Data.i @free(), @set(), @unset(), @get(), @is(), @bucketsUsed(), @elements()
   EndDataSection
EndModule

; ***************************************************************************************

Define r1.s = ""

Define buckets.i = 2048
Define myMap.MapI2I::MapI2I = MapI2I::newMapI2I(buckets)

Define start, time1, time2, time3
Define a, i

NewMap ValueH.i(buckets)
NewMap ValueS.i(buckets)

RandomSeed(123)
start = ElapsedMilliseconds()
For i = 1 To 200000
  a = Random(900000000, 100000000)
  ValueH(Hex(a)) = a
Next
time1 = ElapsedMilliseconds() - start

RandomSeed(123)
start = ElapsedMilliseconds()
For i = 1 To 200000
  a = Random(900000000, 100000000)
  ValueS(XMap(a)) = a
Next
time2 = ElapsedMilliseconds() - start



RandomSeed(123)
start = ElapsedMilliseconds()
For i = 1 To 200000
  a = Random(900000000, 100000000)
  If Not myMap\is(a)
    myMap\set(a,a)
  EndIf
Next
time3 = ElapsedMilliseconds() - start

r1 + #LF$ + #LF$ + "Zeit für große Zahlen anlegen (Pointer, #PB_Any)" + #LF$ + "Hex: " + Str(time1) + #LF$ + "XMap: " + Str(time2)  + #LF$ + "IMap: " + Str(time3)

; Suchen
a = 0
RandomSeed(123)
start = ElapsedMilliseconds()
For i = 1 To 200000
  If FindMapElement(ValueH(), Hex(Random(90000000, 10000000)))
    a + 1  
  EndIf
Next
time1 = ElapsedMilliseconds() - start

a = 0
RandomSeed(123)
start = ElapsedMilliseconds()
For i = 1 To 200000
  If FindMapElement(ValueS(), XMap(Random(90000000, 10000000)))
    a + 1  
  EndIf
Next
time2 = ElapsedMilliseconds() - start

a = 0
RandomSeed(123)
start = ElapsedMilliseconds()
For i = 1 To 200000
  If myMap\get(Random(90000000, 10000000))
    a + 1  
  EndIf
Next
time3 = ElapsedMilliseconds() - start

r1 + #LF$ + #LF$ + "Zeit für suchen große Zahlen (Pointer, #PB_Any)" + #LF$ + "Hex: " + Str(time1) + #LF$ + "XMap: " + Str(time2) + #LF$ + "IMap: " + Str(time3)
r1 + #LF$ + #LF$ + "Count of Map Hex: " + Str(MapSize(ValueH()))
r1 + #LF$ +  "Count of Map XMap: " + Str(MapSize(ValueS()))
r1 + #LF$ +  "Count of Map IMap: " + myMap\elements()
;r1 + #LF$ +  "Count of Map IMap BucketsUsed: " + myMap\bucketsUsed()

MessageRequester("Result", r1)

[mk-soft]

@Nick...

Ein ExamineMap und NextMap wäre schön

[NicTheQuick]

Legt so aber leider noch Duplikate an. Somit prüfe ich das vorher mit Map\Is(). Kann aber so nicht das Value ändern.
Das Flag #PB_Map_ElementCheck (Default) und #PB_Map_NoElementCheck zu Map\Set() hinzufügen und dann ins Code,Tipp und Tricks

Also hättest du gerne noch die Funktionialität von '#PB_Map_NoElementCheck' dabei? Lässt sich machen. Aber einfacher wäre es beim aktuellen Aufbau dann, wenn das alte Element bleibt und jedes neu angelegte versteckt ist.

Einen Iterator wie ForEach bei den PB-Maps kann man auch noch einbauen. Das ist jetzt auch kein Hexenwerk mehr. Threadsicher ist das ganze Teil auch noch nicht. Das kann ich aber gerne nachrüsten. Wenn ich noch ein ExamineMap und NextMap einbaue und es gleichzeitig noch Threadsicher sein soll, wird der Code noch viel komplexer, damit es zu keinen Fehlern kommt, wenn gerade ein Element aktuell ist und ein anderer Thread es gleichzeitig löschen möchte. Dann müsste ich noch meinen Monitor dazu bauen.

Edit:
Ich hab das ganze eben auch nur nebenbei so dahinprogrammiert. Ich wette mit fallen bei näherem Betrachten noch ein paar Stellen auf, die man besser machen könnte. Vielleicht verlangsamt das Interface auch nochmal alles ein bisschen. Das könnte man vielleicht auch mal ohne Interface probieren.
Mir fällt grad auf, dass ich den Quellcode noch nicht mal gespeichert hab.

[GPI]

Threadsicher sind die PB Map und Listen auch nicht. Wer das braucht, kann ja selbst absichern
Aber wäre es nicht besser, wenn das neue angelegte Element sichtbar ist und das alte versteckt ist. Man müsste dann halt das neue Element nicht am ende der Liste hinzufügen, sondern am anfang.
Einen Iterator wäre sehr praktisch, sollte so gestalltet sein, das man da auch gleichzeitig Elemente löschen kann und der Iterator nicht komplett durcheinander kommt.

Erstellt die Original-Map auch so viele Buckets? Welcher Bucket-Wert macht denn am meisten Sinn? Je mehr, desto besser, denk ich, aber was sind gute Werte?

Anwendungsfall bei mir wäre, das ich eine Tabelle PB-Handle -> *Object erstelle. Einige PB-Befehle geben ja zurück, das sich an Kooridnaten x/y sich Objekt "Handle" befindet, das müsste ich schnellstmöglich auf *Object umrechnen können. Zudem möchte ich alle Objecte sauber löschen, die noch vor den schließen des Programms exestieren, wären ja in der Liste. Nur trägt sich das *Object automatisch aus der MAP aus, wenn man es löscht.

Ob das Interface soviel Leistung frisst? Man muss eh immer ein Element übergeben. Und mich würde es nicht wundern, wenn die Optimierungs und Cache-Routinen der CPUs nicht "Interfaces" kennen. Wird ja überall eingesetzt.

[mk-soft]

@NicTheQuick

#PB_Map_NoElementCheck brauch ich eigentlich nicht.

Aber das überschreiben eines vorhandenen Eintrag mit xx\Set(...) wäre gut, oder ist das schon so?
Wenn ja, dann stimmt deine Zählung von vorhandene Einträge nicht. 'xx\Elements()'

[NicTheQuick]

Stimmt, ich hab auch beim Update die Elemente plus 1 gezählt. Ich hab das bei mir jetzt korrigiert. Hier im Forum noch nicht. Ich schreibe erst mal noch einen Iterator dazu.

[GPI]

Ich war jetzt auch mal fleisig:
Benötigt meine Class.pbi von hier:
http://www.purebasic.fr/german/viewtopi ... =8&t=30296

Funktioniert ähnlich zu Nics code, ich hab aber ein paar Verbesserungen eingebracht. Zum einen wird nicht für jedes Element Speicher angefordert, sondern ich benutze Speicherblöcke. Da ich jetzt keine groß kompliziere "was ist denn frei" liste wollte, gibts zusätzlich einen "empty"-Bucket, wo alle gelöschte Elemente verkettet sind. Erst wenn diese leer ist, wird aus den Speicherblock ein Element genommen. Und wenn der Speicherblock leer ist, dann wird ein neuer angefordert.
Nachteil ist hier natürlich, das einmal reservierter Speicher nie freigegeben wird (außer durch Clear() oder Free()). Vorteil ist aber, das die Speicherreservierung deutlich schneller geht (ich komm damit auf die Hälfte der Zeit) und imo auch der Speicherfragmentierung (ist das bei Windows noch ein Problem, oder regelt das OS dass?).

Achja, wenn man eine Examine()-While next():Wend - schleife baut. Remove() setzt den Pointer des aktuellen Elements zurück. Nach Remove sollte man am besten die Schleife verlassen. Gleiches gilt für Set(). SetValue() ist dagegen komplett ungefährlich.

Code: Alles auswählen

XIncludeFile "class.pbi"
;-IndexMap
DeclareModule IndexMap  
  EnableExplicit
  Interface IndexMap
    Exist(index)
    Set(index,value,DontSearch.i=#False)
    Get(index)
    Remove(index)
    
    First()
    Examine()
    Next()
    
    GetValue()
    GetIndex()
    SetValue(value)
    
    GetSize()
    
    Clear()
    Free()
    _NewMemoryBlock()
    _FreeMemoryBlock()
  EndInterface
  Structure sIndexMap
    *__vt
    *IndexMap.IndexMap
    cBucketSize.i
    cMemoryBlockSize.i
    
    CountElements.i
    
    *pMemoryBlock.MemoryBlock
    *pBucket.BucketList
    
    *pLastElement.IndexElement
    LastBucket.i
    
    *pEmptyElement.IndexElement
    *pEmptyAdr.IndexElement
    CountEmptyAdr.i
    
  EndStructure
  class::Declare(IndexMap)
  Declare New(BucketCount=512,cMemoryBlockSize=512)
EndDeclareModule
;-


Module IndexMap
  DisableDebugger
  
  Declare IndexMap_Exist(*self.sIndexMap,index)
  Declare IndexMap_Set(*self.sIndexMap,index,value,DontSearch.i=#False)
  Declare IndexMap_Get(*self.sIndexMap,index)
  Declare IndexMap_Remove(*self.sIndexMap,index)
  Declare IndexMap_First(*self.sIndexMap)
  Declare IndexMap_Examine(*self.sIndexMap)
  Declare IndexMap_Next(*self.sIndexMap)
  Declare IndexMap_GetValue(*self.sIndexMap)
  Declare IndexMap_GetIndex(*self.sIndexMap)
  Declare IndexMap_SetValue(*self.sIndexMap,value)
  Declare IndexMap_GetSize(*self.sIndexMap)
  Declare IndexMap_Clear(*self.sIndexMap)
  Declare IndexMap_Free(*self.sIndexMap)
  Declare IndexMap__NewMemoryBlock(*self.sIndexMap)
  Declare IndexMap__FreeMemoryBlock(*self.sIndexMap)
   
  Structure Para
    cBucketSize.i
    cMemoryBlockSize.i
  EndStructure
  Procedure New(BucketCount=512,MemoryBlockSize=512)
    Protected para.para
    para\cBucketSize=BucketCount
    para\cMemoryBlockSize=MemoryBlockSize
    ProcedureReturn IndexMap\new(Para)
  EndProcedure
  
  ; Siehe https://stackoverflow.com/a/12996028/4239139
  CompilerIf SizeOf(Integer) = 4
    Macro hash(x,y)
      x = ((x >> 16) ! x) * $45d9f3b
      x = ((x >> 16) ! x) * $45d9f3b
      x = (x >> 16) ! x
      x % y
    EndMacro
  CompilerElse
    Macro hash(x,y)
      x = (x ! (x >> 30)) * $bf58476d1ce4e5b9
      x = (x ! (x >> 27)) * $94d049bb133111eb
      x = x ! (x >> 31)
      x % y
    EndMacro
  CompilerEndIf
  
  Structure IndexElement
    index.i
    value.i
    *pNext.IndexElement
  EndStructure
    
  Structure MemoryBlock
    *pNext.MemoryBlock
    Element.IndexElement[0]
  EndStructure
  
  Structure BucketList
    *pElements.IndexElement[0]
  EndStructure
  
  class::Define(IndexMap)
  Runtime Procedure IndexMap_IndexMapEx(*self.sIndexMap,*para.para)
    *self\IndexMap=*self
    If *para
      *self\cBucketSize     =*para\cBucketSize
      *self\cMemoryBlockSize=*para\cMemoryBlockSize
    Else
      *self\cBucketSize     =512
      *self\cMemoryBlockSize=512
    EndIf
    *self\pBucket=AllocateMemory( *self\cBucketSize * SizeOf(integer) )
    *self\IndexMap\_NewMemoryBlock()
    ProcedureReturn #True
  EndProcedure
  Runtime Procedure IndexMap_DeIndexMap(*self.sIndexMap)
    *self\IndexMap\_FreeMemoryBlock()
    FreeMemory(*self\pBucket)
  EndProcedure
  
  Runtime Procedure IndexMap__NewMemoryBlock(*self.sIndexMap)
    Protected *adr.MemoryBlock
    *adr=AllocateMemory(SizeOf(MemoryBlock)+SizeOf(IndexElement) * *self\cMemoryBlockSize,#PB_Memory_NoClear)
    If *adr
      *adr\pNext=*self\pMemoryBlock
      *self\pMemoryBlock=*adr
      *self\pEmptyAdr=*adr\Element
      *self\CountEmptyAdr=*self\cMemoryBlockSize
      ;Debug "Allocate block "+Hex(*adr)+" to "+Hex(*adr+ SizeOf(MemoryBlock)+SizeOf(IndexElement) * *self\cMemoryBlockSize -1)
    EndIf
    ProcedureReturn *adr
  EndProcedure
  Runtime Procedure IndexMap__FreeMemoryBlock(*self.sIndexMap)
    Protected *next
    While *self\pMemoryBlock
      *next=*self\pMemoryBlock\pNext
      ;Debug "Free Block "+Hex(*self\pMemoryBlock)
      FreeMemory(*self\pMemoryBlock)
      *self\pMemoryBlock=*next
    Wend
  EndProcedure
    
  Runtime Procedure IndexMap_Free(*self.sIndexMap)
    class::Free(*self)
  EndProcedure
  Runtime Procedure IndexMap_Clear(*self.sIndexMap)
    Protected i
    *self\IndexMap\_FreeMemoryBlock()
    *self\IndexMap\_NewMemoryBlock()
    For i=0 To *self\cBucketSize-1
      *self\pBucket\pElements[i]=0
    Next
    *self\CountElements=0
    *self\pEmptyElement=0
    *self\pLastElement=0
  EndProcedure   
  Runtime Procedure IndexMap_Exist(*self.sIndexMap,Index)
    Protected i=index,
              *adr.IndexElement
    hash(i,*self\cBucketSize)
    *adr=*self\pBucket\pElements[i]
    While *adr
      If *adr\index=index
        Break
      EndIf
      *adr=*adr\pNext
    Wend
    *self\pLastElement=*adr
    *self\LastBucket=i
    ProcedureReturn *adr
  EndProcedure
  Runtime Procedure IndexMap_Get(*self.sIndexMap,Index)
    If IndexMap_Exist(*self,index)
      ProcedureReturn *self\pLastElement\value
    EndIf
    ProcedureReturn 0
  EndProcedure
  Runtime Procedure IndexMap_Set(*self.sIndexMap,index,value,DontSearch=#False)
    Protected *adr.IndexElement,i
    *self\LastBucket=-1
    If DontSearch=#False And IndexMap_Exist(*self,index)
      *self\pLastElement\value=value
    Else     
      If *self\LastBucket=-1
        i=index
        hash(i,*self\cBucketSize)
        *self\LastBucket=i
      EndIf
      ;*adr=*self\IndexMap\_GetFreeElement()
      ;Protected *adr.IndexElement
      If *self\pEmptyElement
        *adr=*self\pEmptyElement
        *self\pEmptyElement=*adr\pNext
        ;Debug "New from empty"
      ElseIf *self\CountEmptyAdr>0 Or *self\IndexMap\_NewMemoryBlock()
        *adr=*self\pEmptyAdr
        *self\pEmptyAdr + SizeOf(IndexElement)
        *self\CountEmptyAdr-1
        ;Debug "new from block"
      EndIf
      *self\CountElements+1
      
      *adr\pNext=*self\pBucket\pElements[*self\LastBucket]
      *adr\index=index
      *adr\value=value
      *self\pBucket\pElements[*self\LastBucket]=*adr
    EndIf
    
    *self\pLastElement=*adr
  EndProcedure 
  Runtime Procedure IndexMap_GetValue(*self.sIndexMap)
    ProcedureReturn *self\pLastElement\value
  EndProcedure
  Runtime Procedure IndexMap_SetValue(*self.sIndexMap,value)
    *self\pLastElement\value=value
  EndProcedure
  Runtime Procedure IndexMap_GetIndex(*self.sIndexMap)
    ProcedureReturn *self\pLastElement\index
  EndProcedure
  Runtime Procedure IndexMap_First(*self.sIndexMap)
    *self\LastBucket=0
    While *self\pBucket\pElements[*self\LastBucket]=0 And *self\LastBucket<*self\cBucketSize-1
      *self\LastBucket+1
    Wend
    *self\pLastElement=*self\pBucket\pElements[*self\LastBucket]
    ProcedureReturn *self\pLastElement
  EndProcedure
  Runtime Procedure Indexmap_Next(*self.sIndexMap)
    If *self\LastBucket=-1
      ProcedureReturn IndexMap_First(*self.sIndexMap)
    ElseIf *self\pLastElement
      
      If *self\pLastElement\pNext
        *self\pLastElement=*self\pLastElement\pNext
        
      ElseIf *self\LastBucket=*self\cBucketSize-1
        *self\pLastElement=0
        *self\LastBucket=0
        
      Else
        *self\LastBucket+1
        While *self\pBucket\pElements[*self\LastBucket]=0 And *self\LastBucket<*self\cBucketSize-1
          *self\LastBucket+1
        Wend
        *self\pLastElement=*self\pBucket\pElements[*self\LastBucket]
      EndIf      
    EndIf  
    ProcedureReturn *self\pLastElement
  EndProcedure
  Runtime Procedure IndexMap_Examine(*self.sIndexMap)
    *self\LastBucket=-1
    *self\pLastElement=0
    ProcedureReturn *self\CountElements
  EndProcedure
  Runtime Procedure IndexMap_Remove(*self.sIndexMap,index)
    Protected i=index,*prev.IndexElement,*cur.IndexElement
    hash(i,*self\cBucketSize)
    *cur=*self\pBucket\pElements[i]
    While *cur And *cur\index<>index
      *prev=*cur
      *cur=*cur\pNext
    Wend
    If *cur
      ;Element aus Bucket austragen
      If *prev=0
        *self\pBucket\pElements[i]=*cur\pNext
      Else
        *prev\pNext=*cur\pNext
      EndIf
      
      
      ;Element in empty eintragen
      *cur\pNext=*self\pEmptyElement
      *self\pEmptyElement=*cur
      
      *self\CountElements-1
      *self\pLastElement=0
      
    EndIf
  EndProcedure
  Runtime Procedure IndexMap_GetSize(*self.sIndexMap)
    ProcedureReturn *self\CountElements
  EndProcedure
EndModule
;---
CompilerIf #PB_Compiler_IsMainFile
    ;-example

    ; Comment: Stringkey aus Integer
    ; Author1: GPI
    ; Author2: mk-soft
    ; Date:    31.08.2017

    CompilerIf #PB_Compiler_Processor=#PB_Processor_x86
      #_handlemask=$11111111
      #_handleadd= $22222222
      Structure udtXMap
        StructureUnion
          key.i[2]
          CompilerIf #PB_Compiler_Unicode
            s.s{4}
          CompilerElse
            s.s{8}
          CompilerEndIf 
          null.w
        EndStructureUnion
      EndStructure
    CompilerElse
      #_handlemask=$1111111111111111
      #_handleadd= $2222222222222222
      Structure udtXMap
        StructureUnion
          key.i[2]
          CompilerIf #PB_Compiler_Unicode
            s.s{8}
          CompilerElse
            s.s{16}
          CompilerEndIf 
          null.w
        EndStructureUnion
      EndStructure
    CompilerEndIf

    Procedure.s XMap(i)
      Protected r1.udtXMap
      r1\key[0] = (i | #_handlemask)
      r1\key[1] = (i & #_handlemask) | #_handleadd
      ProcedureReturn r1\s
    EndProcedure

    Define r1.s = ""

    #buckets = 2048
    Define myMap.IndexMap::IndexMap= IndexMap::new(#buckets,1000)

    Define start, time1, time2, time3
    Define a, i
    Define err.s
    
    NewList Rnd()
    For i=1 To 200000
      AddElement(Rnd())
      rnd()=Random(90000000, 10000000)
    Next
    

    NewMap ValueH.i(#buckets)
    NewMap ValueS.i(#buckets)

    start = ElapsedMilliseconds()
    ForEach Rnd()
      a = Rnd()
      ValueH(Hex(a)) = a
    Next
    time1 = ElapsedMilliseconds() - start

    start = ElapsedMilliseconds()
    ForEach Rnd()
      a = Rnd()
      ValueS(XMap(a)) = a
    Next
    time2 = ElapsedMilliseconds() - start

    start = ElapsedMilliseconds()
    ForEach Rnd()
      a = Rnd()
      myMap\set(a,a)
    Next
    time3 = ElapsedMilliseconds() - start

    r1 + #LF$ + #LF$ + "Zeit für große Zahlen anlegen (Pointer, #PB_Any)" + #LF$ + "Hex: " + Str(time1) + #LF$ + "XMap: " + Str(time2)  + #LF$ + "IMap: " + Str(time3)
    
    ;nachschlag
    For i=1 To 100000
      AddElement(Rnd())
      rnd()=Random(10000000, 1)
    Next
    
    ; Suchen
    a1 = 0
    start = ElapsedMilliseconds()
    ForEach rnd()
      If FindMapElement(ValueH(), Hex(Rnd()) )
        If ValueH()<>rnd()
          err+ "Fehler hex!"
        EndIf
        a1 + 1 
      EndIf
    Next
      
    time1 = ElapsedMilliseconds() - start

    a2 = 0
    start = ElapsedMilliseconds()
    ForEach rnd()
      If FindMapElement(ValueS(), XMap(rnd()) )
        If ValueS()<>rnd()
          err+ "Fehler XMAP"
        EndIf
        a2 + 1 
      EndIf
    Next
    time2 = ElapsedMilliseconds() - start

    a3 = 0
    RandomSeed(123)
    start = ElapsedMilliseconds()
    ForEach rnd()
      If myMap\get(rnd())
        If myMap\GetValue()<>rnd()
          err+ "Fehler indexmap"
        EndIf
        a3 + 1 
      EndIf
    Next
    time3 = ElapsedMilliseconds() - start
    
    
    r1 +err+ #LF$ + #LF$ + "Zeit für suchen große Zahlen (Pointer, #PB_Any)" + #LF$ + "Hex: " + Str(time1) + #LF$ + "XMap: " + Str(time2) + #LF$ + "IMap: " + Str(time3)
    r1 + #LF$ + #LF$ + "Count of Map Hex: " + Str(MapSize(ValueH()))+" "+a1
    r1 + #LF$ +  "Count of Map XMap: " + Str(MapSize(ValueS()))+" "+a2
    r1 + #LF$ +  "Count of Map IMap: " + myMap\GetSize()+" "+a3
    SetClipboardText(r1)
    ;r1 + #LF$ +  "Count of Map IMap BucketsUsed: " + myMap\pBucketsUsed()
    
    mymap\free()
    
    MessageRequester("Result", r1)

CompilerEndIf

Meine Ergebnisse:

Zeit für große Zahlen anlegen (Pointer, #PB_Any)
Hex: 3158
XMap: 1115
IMap: 636

Zeit für suchen große Zahlen (Pointer, #PB_Any)
Hex: 2506
XMap: 3601
IMap: 1476

Count of Map Hex: 199744 200000
Count of Map XMap: 199744 200000
Count of Map IMap: 199744 200000

edit: ein paar fehler behoben

[NicTheQuick]

Ich habe mal endlich Zeit gefunden meine Map um einen Iterator zu erweitern.
Man kann beliebig viele Iteratoren erzeugen und unabhängig voneinander auf sie zugreifen. Das funktioniert auch mit mehreren Threads, solange man die Map in der Zeit nicht ändert. Ansonsten ist hier noch gar nichts Threadsicher. Hat man einen Iterator erzeugt und ändert die Map, kann es passieren, dass es zu einem Crash kommt.

Außerdem gibt es neue Methoden, die alle Keys oder Values auf einmal in ein Array oder eine LinkedList schreiben.

Hier also das Modul inklusive Beispiel:

Code: Alles auswählen

EnableExplicit

DeclareModule MapI2I
	EnableExplicit
	Interface MapI2I
		free.i()
		set.i(key.i, value.i)
		unset.i(key.i)
		get.i(key.i)
		is.i(key.i)
		newIterator.i()
		keysToArray(Array keys.i(1))
		valuesToArray(Array keys.i(1))
		keysToLinkedList(List keys.i())
		valuesToLinkedList(List keys.i())
		bucketsUsed.i()
		elements.i()
		memoryUsed.i()
	EndInterface
	
	Interface Iterator
		free.i()
		isNext.i()
		key.i()
		value.i()
		bucket.i()
		bucketIndex.i()
		nextElement.i()
	EndInterface
	
	Declare newMapI2I(buckets.i)
EndDeclareModule

Module MapI2I
	EnableExplicit
	Structure entry
		key.i
		value.i
		*next.entry		; Wird zu beginn auf 1 gesetzt um zu signalisieren, dass das Element noch nicht existiert.
	EndStructure
	
	Structure entries
		entry.entry[0]
	EndStructure
	
	Structure table
		*vTable
		buckets.i
		bucketsUsed.i
		elements.i
		*entries.entries
	EndStructure
	
	Structure it
		*vTable
		*table.table
		*entry.entry
		bucket.i
		iBucket.i
	EndStructure
	
	; Siehe https://stackoverflow.com/a/12996028/4239139
	CompilerIf SizeOf(Integer) = 4
		Macro hash(x, y)
			x = ((x >> 16) ! x) * $45d9f3b
			x = ((x >> 16) ! x) * $45d9f3b
			x = (x >> 16) ! x
			x % y
		EndMacro
	CompilerElse
		Macro hash(x, y)
			x = (x ! (x >> 30)) * $bf58476d1ce4e5b9
		    x = (x ! (x >> 27)) * $94d049bb133111eb
		    x = x ! (x >> 31);
		    x % y
		EndMacro
	CompilerEndIf
	
	Procedure newMapI2I(buckets.i)
		Protected *this.table, i.i
		
		If buckets < 1
			ProcedureReturn #False
		EndIf
		
		*this = AllocateStructure(table)
		If Not *this
			ProcedureReturn #False
		EndIf
		
		
		With *this
			\vTable = ?vTable_mapI2I
			\buckets = buckets.i
			\bucketsUsed = 0
			\elements = 0
			\entries = AllocateMemory(SizeOf(entry) * buckets, #PB_Memory_NoClear)
			If Not \entries
				FreeStructure(*this)
				ProcedureReturn #False
			EndIf
			For i = 0 To buckets - 1
				\entries\entry[i]\next = 1
			Next
		EndWith
		
		ProcedureReturn *this
	EndProcedure
	
	Procedure.i free(*this.table)
		Protected i.i, *entry.entry, *nextEntry.entry
		With *this
			For i = 0 To *this\buckets - 1
				If \entries\entry[i]\next <> 1
					*entry = \entries\entry[i]\next
					While *entry
						*nextEntry = *entry\next
						FreeMemory(*entry)
						*entry = *nextEntry
					Wend
				EndIf
			Next
			FreeMemory(\entries)
			FreeStructure(*this)
		EndWith
	EndProcedure
	
	Procedure.i is(*this.table, key.i)
		Protected *entry.entry, bucket.i = key
		hash(bucket, *this\buckets)
		*entry = @*this\entries\entry[bucket]
		If *entry\next = 1
			ProcedureReturn #False
		EndIf
		While *entry
			If *entry\key = key
				ProcedureReturn #True
			EndIf
			*entry = *entry\next
		Wend
		
		ProcedureReturn #False
	EndProcedure
	
	Procedure.i get(*this.table, key.i)
		Protected *entry.entry, bucket.i = key
		hash(bucket, *this\buckets)
		*entry = @*this\entries\entry[bucket]
		If *entry\next = 1
			ProcedureReturn #False
		EndIf
		While *entry
			If *entry\key = key
				ProcedureReturn *entry\value
			EndIf
			*entry = *entry\next
		Wend
		
		ProcedureReturn #False
	EndProcedure
	
	Procedure.i set(*this.table, key.i, value.i)
		Protected *entry.entry, bucket.i = key, *lastEntry.entry
		hash(bucket, *this\buckets)
		*entry = @*this\entries\entry[bucket]
		*lastEntry = *entry
		If *entry\next = 1
			*this\bucketsUsed + 1
		Else
			Repeat
				If *entry\key = key
					*entry\value = value
					ProcedureReturn *entry
				EndIf
				*lastEntry = *entry
				*entry = *entry\next
			Until Not *entry
		EndIf
		If *lastEntry\next = 1
			*lastEntry\key = key
			*lastEntry\value = value
			*lastEntry\next = 0
			*this\elements + 1
			ProcedureReturn *lastEntry
		Else
			*lastEntry\next = AllocateMemory(SizeOf(entry), #PB_Memory_NoClear)
			If Not *lastEntry\next
				ProcedureReturn #False
			EndIf
			*lastEntry\next\key = key
			*lastEntry\next\value = value
			*lastEntry\next\next = 0
			*this\elements + 1
			ProcedureReturn *lastEntry\next
		EndIf
	EndProcedure
	
	Procedure.i unset(*this.table, key.i)
		Protected *entry.entry, bucket.i = key, *firstEntry.entry, *previousEntry.entry
		hash(bucket, *this\buckets)
		*entry = @*this\entries\entry[bucket]
		*firstEntry = *entry
		*previousEntry = *entry
		If *entry\next = 1
			ProcedureReturn #False
		EndIf
		While *entry
			If *entry\key = key
				If *entry = *firstEntry
					If *entry\next = 0
						; Der einzige Eintrag der LinkedList soll gelöscht werden
						*this\bucketsUsed - 1
						*entry\next = 1
					Else
						; Der erste Eintrag der LinkedList soll gelöscht werden und es folgt noch mindestens ein weiterer
						*entry\key = *entry\next\key
						*entry\value = *entry\next\value
						*entry\next = *entry\next\next
					EndIf
					*this\elements - 1
					ProcedureReturn #True
				Else
					; Der zweite oder einer der nachfolgenden Einträge soll gelöscht werden.
					*previousEntry\next = *entry\next
					FreeMemory(*entry)
					*this\elements - 1
					ProcedureReturn #True
				EndIf
			EndIf
			*previousEntry = *entry
			*entry = *entry\next
		Wend
		
		ProcedureReturn #False
	EndProcedure

	Procedure.i newIterator(*this.table)
		Protected *it.it = AllocateStructure(it)
		If Not *it
			ProcedureReturn #False
		EndIf
		
		With *it
			\vTable = ?vTable_it
			\table = *this
			\bucket = -1
			\iBucket = 0
		EndWith
		
		ProcedureReturn *it
	EndProcedure
	
	Procedure.i itFree(*this.it)
		FreeStructure(*this)
		ProcedureReturn #True
	EndProcedure
	
	Procedure.i itIsNext(*this.it)
		Protected curIBucket.i
		With *this
			; Sind wir schon über das Ende?
			If \iBucket = \table\buckets
				ProcedureReturn #False
			EndIf
			
			; Wenn wir noch gar nicht angefangen haben mit dem Iterieren, es aber Elemente in der Map gibt, dann gibt es natürlich ein nächstes Element.
			If Not \entry And \table\elements
				ProcedureReturn #True
			EndIf
			
			; Ab hier gehen wir davon aus, dass das aktuelle Element existiert
			
			; Existiert ein weiteres Element im gleichen Bucket?
			If \entry\next
				ProcedureReturn #True
			EndIf
			
			; Ansonsten gehe zum nächsten nicht leeren Bucket
			curIBucket = \iBucket + 1
			While curIBucket < \table\buckets And \table\entries\entry[curIBucket]\next = 1
				curIBucket + 1
			Wend
			; Wenn das Ende erreicht wurde, gibt es keinen weiteren.
			If curIBucket = \table\buckets
				ProcedureReturn #False
			EndIf
			ProcedureReturn #True
		EndWith
	EndProcedure
	
	Procedure.i itNextElement(*this.it)
		With *this
			If \iBucket = \table\buckets
				ProcedureReturn #False
			EndIf
			
			; Wenn wir noch gar nicht angefangen haben mit dem Iterieren, es aber Elemente in der Map gibt, dann gibt es natürlich ein nächstes Element.
			If Not \entry And \table\elements
				\iBucket = 0
				\bucket = 0
				While \iBucket < \table\buckets And \table\entries\entry[\iBucket]\next = 1
					\iBucket + 1
				Wend
				\entry = \table\entries\entry[\iBucket]
				ProcedureReturn Bool(\iBucket < \table\buckets)
			EndIf
			
			; Ab hier gehen wir davon aus, dass das aktuelle Element existiert
			
			; Existiert ein weiteres Element im gleichen Bucket?
			If \entry\next
				\entry = \entry\next
				\bucket + 1
				ProcedureReturn #True
			EndIf
			
			\bucket = 0
			\iBucket + 1
			; Ansonsten gehe zum nächsten nicht leeren Bucket
			While \iBucket < \table\buckets And \table\entries\entry[\iBucket]\next = 1
				\iBucket + 1
			Wend
			; Wenn das Ende erreicht wurde, gibt es keinen weiteren.
			If \iBucket = \table\buckets
				ProcedureReturn #False
			EndIf
			\entry = \table\entries\entry[\iBucket]
			ProcedureReturn #True
		EndWith
	EndProcedure

	Procedure.i itKey(*this.it)
		If *this\entry
			ProcedureReturn *this\entry\key
		EndIf
		ProcedureReturn #False
	EndProcedure
	
	Procedure.i itValue(*this.it)
		If *this\entry
			ProcedureReturn *this\entry\value
		EndIf
		ProcedureReturn #False
	EndProcedure
	
	Procedure.i itBucket(*this.it)
		ProcedureReturn *this\bucket
	EndProcedure
	
	Procedure.i itBucketIndex(*this.it)
		ProcedureReturn *this\iBucket
	EndProcedure
	
	Procedure.i bucketsUsed(*this.table)
		ProcedureReturn *this\bucketsUsed
	EndProcedure
	
	Procedure.i elements(*this.table)
		ProcedureReturn *this\elements
	EndProcedure
	
	Procedure.i memoryUsed(*this.table)
		ProcedureReturn SizeOf(table) + SizeOf(entry) * *this\buckets + Bool(*this\elements > *this\bucketsUsed) * (*this\elements - *this\bucketsUsed) * SizeOf(entry)
	EndProcedure
	
		Macro _toArray(name, member)

		Procedure.i name#ToArray(*this.table, Array arr.i(1))
			Protected i.i, *entry.entry, j.i
			
			ReDim arr(*this\elements - 1)
		
			For i = 0 To *this\buckets - 1
				*entry = @*this\entries\entry[i]
				If *entry\next <> 1
					While *entry
						arr(j) = *entry\member
						j + 1
						*entry = *entry\next
					Wend
				EndIf
			Next
		EndProcedure
	EndMacro
	
	_toArray(keys, key)
	_toArray(values, value)
	
	Macro _toLinkedList(name, member)
		Procedure.i name#ToLinkedList(*this.table, List ll.i())
			Protected i.i, *entry.entry
			
			ClearList(ll())
		
			For i = 0 To *this\buckets - 1
				*entry = @*this\entries\entry[i]
				If *entry\next <> 1
					While *entry
						If AddElement(ll())
							ll() = *entry\member
						EndIf
						
						*entry = *entry\next
					Wend
				EndIf
			Next
		EndProcedure
	EndMacro
	
	_toLinkedList(keys, key)
	_toLinkedList(values, value)
	
	DataSection
		vTable_mapI2I:
			Data.i @free(), @set(), @unset(), @get(), @is(), @newIterator(), @keysToArray(), 
			       @valuesToArray(), @keysToLinkedList(), @valuesToLinkedList(),
			       @bucketsUsed(), @elements(), @memoryUsed()
		vTable_it:
			Data.i @itFree(), @itIsNext(), @itKey(), @itValue(), @itBucket(), @itBucketIndex(), @itNextElement()
	EndDataSection
EndModule

Procedure.s formatBytes(bytes.q)
	Static suffix.s = "B,KiB,MiB,GiB,TiB,PiT"
	Protected index.i = 1, t.d = bytes
	While t > 1023
		index + 1
		t / 1024
	Wend
	
	ProcedureReturn StrD(t, 3 * index) + " " + StringField(suffix, index, ",")
EndProcedure

OpenConsole()

Define buckets.i = 10
Define myMap.MapI2I::MapI2I = MapI2I::newMapI2I(buckets)
Define i.i, max = 20, key.i

; Erstelle ganz viele Element
RandomSeed(123)
For i = 1 To max
	key.i = Random(1 << 16) + i << 16
	PrintN("Set key: " + key + " value: " + i)
	If Not myMap\set(key, i)
		PrintN("Oh oh. Konnte Element mit key " + key + " nicht anlegen.")
	EndIf
Next

PrintN("Momentan genutzte Buckets: " + myMap\bucketsUsed() + " (" + StrD(100.0 * myMap\bucketsUsed() / buckets, 2) + ~"%)\n" +
       "Durchschnittliche Elemente pro Bucket: " + StrD(myMap\elements() / myMap\bucketsUsed(), 2) + ~"%\n" +
       "Speicherverbrauch: " + formatBytes(myMap\memoryUsed()))

; Überprüfe ihren Inhalt
RandomSeed(123)
For i = 1 To max
	key.i = Random(1 << 16) + i << 16
	If myMap\get(key) <> i
		PrintN("i=" + key + " sollte den Wert " + i + " haben, hat aber " + myMap\get(key))
	EndIf
Next

; Lösche die Hälfte
RandomSeed(123)
For i = 1 To max
	key.i = Random(1 << 16) + i << 16
	If i & 1
		If Not myMap\unset(key)
			PrintN("Nanu? Wieso existiert der Eintrag " + key + " nicht?")
		EndIf
	EndIf
Next

PrintN("Momentan genutzte Buckets: " + myMap\bucketsUsed() + " (" + StrD(100.0 * myMap\bucketsUsed() / buckets, 2) + ~"%)\n" +
       "Durchschnittliche Elemente pro Bucket: " + StrD(myMap\elements() / myMap\bucketsUsed(), 2) + ~"\n" +
       "Speicherverbrauch: " + formatBytes(myMap\memoryUsed()))

; Überprüfe Löschung und die Existenz der restlichen
RandomSeed(123)
For i = 1 To max
	key.i = Random(1 << 16) + i << 16
	If myMap\is(key) And i & 1
		PrintN("oh oh. Key " + key + " sollte nicht mehr existieren.")
	ElseIf Not myMap\is(key) And i & 1 = 0
		PrintN("oh oh. Key " + key + " sollte noch existieren.")
	EndIf
Next

; Alle Schlüssel in einem Array
NewList	values()

myMap\valuesToLinkedList(values())
PrintN("Alle Werte in einer LinkedList: (" + ListSize(values()) + ")")
ForEach values()
	PrintN(Str(values()))
Next

PrintN("Iterator über alle Werte:")
Define.MapI2I::Iterator	it = myMap\newIterator()
While it\NextElement()
	PrintN("Key: " + RSet(Str(it\key()), 10) + " Value: " + RSet(Str(it\value()), 10) + " iBucket: " + RSet(Str(it\bucketIndex()), 10) + " Bucket: " + Str(it\bucket()))
Wend
it\free()


myMap\free()
PrintN("Ende Gelände.")
Input()
CloseConsole()