PureBoard

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)

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

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()