It is currently Sun Dec 15, 2019 2:53 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: Index HashTables
PostPosted: Wed Nov 13, 2019 6:33 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Jul 14, 2006 8:53 pm
Posts: 654
Location: Malta
I must start with an apology as this code is not mine; or at least I was writing something similar, when I came across this code. I could not find it again so I do not know who to credit. I made some minor modifications, to make it more suitable for large maps (the overhead for smaller maps would not justify the extra CPU cycles.) If you know whose code it is please let me know so I attach the proper credits.

What it does?
----------------

This code allows you to create index or multiple indexes for your maps. You can either keep all, or you can limit it to a queue where the largest (or smallest) are kept. The index is independent of the main map. Then you can traverse your map either via the usual way (random) or through one of the indexes.

For really large implementations, a larger prime would be recommended.

Code:
; Share and use freely
; Code adapted by T. Agius
; Original code author: Unkwown
; Mar/2018

EnableExplicit

Enumeration
   #NDXMAP_WITHFASTDEL  = 1
   #NDXMAP_FIRST        = 1
   #NDXMAP_LAST         = 2
   #NDXMAP_PREV         = 3
   #NDXMAP_NEXT         = 4
   #NDXMAP_PRIME        = 16033
   ;#NDXMAP_PRIME        = 34157
EndEnumeration

Structure stIndex
   *p.Integer
EndStructure

Structure stIndexDetails Align #PB_Structure_AlignC
   Name.s
   iCurrSize.i
   iMaxStart.i
   iExpandSize.i
   iQueue.i
   iPos.i
   fnCompare.i
   Array arIndex.stIndex(1)
   CompilerIf #NDXMAP_WITHFASTDEL = 1
      Map mapIndexKeys.i( #NDXMAP_PRIME )
   CompilerEndIf

EndStructure 

Global NewMap        mapIndexMap.stIndexDetails(128)

Macro                ndxmapChangeIndex( indexname )
   FindMapElement( mapIndexMap(), indexname )
EndMacro

Macro                ndxmapElement()
   mapIndexMap()\arIndex( mapIndexMap()\iPos )\p
EndMacro

Macro                ndxmapChangePos( newpos )
   Select newpos
      Case #NDXMAP_FIRST
         mapIndexMap()\iPos = 0
         
      Case #NDXMAP_LAST
         mapIndexMap()\iPos = mapIndexMap()\iCurrSize - 1
         
      Case #NDXMAP_NEXT
         If mapIndexMap()\iPos < ( mapIndexMap()\iCurrSize - 1 )
            mapIndexMap()\iPos + 1
         EndIf
         
      Case #NDXMAP_PREV
         If mapIndexMap()\iPos > 0
            mapIndexMap()\iPos - 1
         EndIf
         
   EndSelect
EndMacro

Procedure            ndxmapCreateIndex( IndexName.s, SizeStart.i, fnCompare, Increment.i = 5000, qSize.i = 0 )
   
   If FindMapElement( mapIndexMap(), IndexName )
      ProcedureReturn -1
   EndIf
   
   AddMapElement( mapIndexMap(), IndexName )
   With mapIndexMap()
      \iCurrSize     = 0
      \iExpandSize   = Increment
      \iMaxStart     = SizeStart
      \fnCompare     = fnCompare
      \iQueue        = qSize
      \Name          = IndexName + "|"
   EndWith
   
   ReDim mapIndexMap()\arIndex( SizeStart + 2 )

EndProcedure

Procedure            ndxmapAdd( *p.Integer )
   
   Protected         iLow.i, iHigh.i, iMid.i
   
   If mapIndexMap()\iCurrSize > 0
      iHigh = mapIndexMap()\iCurrSize
     
      While iLow  <  iHigh
     
         If CallFunctionFast( mapIndexMap()\fnCompare, *p,  mapIndexMap()\arIndex( iLow )\p ) <= 0
            Break
         ElseIf CallFunctionFast( mapIndexMap()\fnCompare, *p,  mapIndexMap()\arIndex( iHigh  -  1 )\p ) >= 0
            iLow  =  iHigh
            Break
         Else
            iMid  =  (iLow  +  iHigh)  >>  1
         EndIf
         
         If CallFunctionFast( mapIndexMap()\fnCompare, mapIndexMap()\arIndex( iMid )\p, *p ) < 0
            iLow  =  iMid  +  1
         Else
            iHigh  =  iMid
         EndIf
      Wend
     
      MoveMemory( @mapIndexMap()\arIndex( iLow ), @mapIndexMap()\arIndex( iLow + 1 ), @mapIndexMap()\arIndex( mapIndexMap()\iCurrSize ) - @mapIndexMap()\arIndex( iLow ) )
   EndIf
   
   mapIndexMap()\arIndex( iLow )\p  = *p
   
   CompilerIf #NDXMAP_WITHFASTDEL = 1   
      AddMapElement( mapIndexMap()\mapIndexKeys(), Str( *p ), #PB_Map_NoElementCheck )
      mapIndexMap()\mapIndexKeys() = iLow
   CompilerEndIf
   
   If mapIndexMap()\iQueue
      If mapIndexMap()\iCurrSize < mapIndexMap()\iQueue
         mapIndexMap()\iCurrSize + 1
      EndIf
   Else
      mapIndexMap()\iCurrSize  +  1
     
      If mapIndexMap()\iCurrSize  >  mapIndexMap()\iMaxStart
          mapIndexMap()\iMaxStart + mapIndexMap()\iExpandSize
          ReDim mapIndexMap()\arIndex( mapIndexMap()\iMaxStart + 2 )
      EndIf
   EndIf
   
EndProcedure

Procedure            ndxmapDelete( *p.Integer )
   Protected         i, j
   
   j = mapIndexMap()\iCurrSize - 1
   
   CompilerIf #NDXMAP_WITHFASTDEL = 1
      If FindMapElement( mapIndexMap()\mapIndexKeys(), Str( *p ) )
         i = mapIndexMap()\mapIndexKeys()
         DeleteMapElement( mapIndexMap()\mapIndexKeys() )
         ;Debug "[DEL=>" + Str( *p ) + " -- " + Str( i )
      Else   
         ProcedureReturn -1
      EndIf   
   CompilerElse   
      For i = 0 To j
         If *p = mapIndexMap()\arIndex( i )\p
            Break
         EndIf
      Next
   CompilerEndIf   
   
   If i < j
      MoveMemory( @mapIndexMap()\arIndex( i + 1 ), @mapIndexMap()\arIndex( i ), @mapIndexMap()\arIndex( mapIndexMap()\iCurrSize ) - @mapIndexMap()\arIndex( i + 1 ) )
   EndIf
   
   mapIndexMap()\iCurrSize - 1
   
EndProcedure

Macro          ndxmapResetIndex( keyname )
   
   ndxmapChangeIndex( keyname )
   mapIndexMap()\iCurrSize = 0
   CompilerIf #NDXMAP_WITHFASTDEL = 1
      ClearMap( mapIndexMap()\mapIndexKeys() )
   CompilerEndIf   
   ;ReDim mapIndexMap()\arIndex( 1 )
   ;ReDim mapIndexMap()\arIndex( mapIndexMap()\iMaxStart )
   
EndMacro


; - End Index Module
;---------------------

CompilerIf #PB_Compiler_IsMainFile

; -----------------------
; Test Code
; -----------------------

#MaxSize = 25

Structure stTest
   sText.s{24}
   iNum.q
   dTest.d
EndStructure

Global            gszBuild.s     = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Global            gLimit

Procedure         CreateRandomData( Size, ptrData )

  Protected       i, j
  Protected       code.s
  Protected       *ptr.CHARacter
 
  *ptr = ptrData
 
  For i = 1 To Size
    j = Random ( gLimit ) + 1
    *ptr\c = Asc( Mid ( gszBuild, j, 1 ) )
    *ptr + SizeOf( Character )
  Next i

EndProcedure     

Procedure         CompareDouble( *p1.stTest, *p2.stTest )
   If *p1\dTest < *p2\dTest
      ProcedureReturn -1
   ElseIf *p1\dTest > *p2\dTest
      ProcedureReturn 1
   EndIf   
   
   ProcedureReturn 0
EndProcedure

Procedure         CompareString( *p1.stTest, *p2.stTest )
   If CompareMemoryString( @*p1\sText, @*p2\sText, #PB_String_NoCase ) = #PB_String_Lower
      ProcedureReturn -1
   ElseIf CompareMemoryString( @*p1\sText, @*p2\sText, #PB_String_NoCase ) = #PB_String_Greater
      ProcedureReturn 1
   EndIf   
   
   ProcedureReturn 0
EndProcedure

Global NewMap mapTest.stTest(#MaxSize)

Define *ptr, *p.stTest,  iIndex.i, sTookString.s
Define j, szText.s

   gLimit = Len( gszBuild )
   ndxmapCreateIndex( "Double", 15000, @CompareDouble(), 20, 5 )
   ndxmapCreateIndex( "String", 15000, @CompareString() )
   
   For iIndex  =  0 To #MaxSize
      *ptr  =  AddMapElement( mapTest(), "Key-"  +  Str(iIndex + 1) )
     
      j = Random(20, 6)
      szText = Space(j)
      CreateRandomData( j, @szText )
      mapTest()\sText   = szText
      mapTest()\iNum    =  Random( 9999999, 100 )
      mapTest()\dTest   = Random(10000, 10)  /  Random(1000, 100)   
     
      Debug "["  +  Str(iIndex)  +  "] Text="  +  mapTest()\sText  +  " ["  +  Str( mapTest()\iNum )  +  "] --> "  +  FormatNumber( mapTest()\dTest, 2 )
      ndxmapChangeIndex( "Double" )
      ndxmapAdd( *ptr )
      ndxmapChangeIndex( "String" )
      ndxmapAdd( *ptr )
   Next
   
   iIndex = 0
   
   Debug "==[Double]===================================="
   ndxmapChangeIndex( "Double" )
   
   For iIndex  =  0 To mapIndexMap()\iCurrSize - 1
      *p.stTest  =  mapIndexMap()\arIndex( iIndex )\p
      Debug "["  +  Str(iIndex)  +  "] sText="  +  *p\sText  +  " ["  +  Str( *p\iNum )  +  "] --> "  +  FormatNumber( *p\dTest, 2 )
   Next
   
   ndxmapChangeIndex( "String" )
   iIndex = 0
   
   ForEach mapTest()
      iIndex + 1
      If Mod( iIndex, 5 ) = 0
         ndxmapDelete( @mapTest() )
         DeleteMapElement( mapTest() )
         Debug "Deleted element"
      EndIf   
   Next
   
   Debug "==[String]===================================="
   ndxmapChangeIndex( "String" )
   
   For iIndex  =  0 To mapIndexMap()\iCurrSize - 1
      *p.stTest  =  mapIndexMap()\arIndex( iIndex )\p
      Debug "["  +  Str(iIndex)  +  "] sText="  +  *p\sText  +  " ["  +  Str( *p\iNum )  +  "] --> "  +  FormatNumber( *p\dTest, 2 )
   Next
   
CompilerEndIf


_________________
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net


Top
 Profile  
Reply with quote  
 Post subject: Re: Index HashTables
PostPosted: Wed Nov 13, 2019 1:55 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Apr 26, 2003 2:15 pm
Posts: 842
Location: Cuernavaca, Mexico
Thanks kinglestat

Looks like you and said were working on this about 18 months ago. :)

https://www.purebasic.fr/english/viewtopic.php?p=519564#p519564

_________________
- It was too lonely at the top.

Current Machine: Win 10 Pro 64-bit, Dual Xeon E5-2670, 64 gigs ram, Geforce GTX 1660 Ti w/6 gigs ram


Top
 Profile  
Reply with quote  
 Post subject: Re: Index HashTables
PostPosted: Wed Nov 13, 2019 2:33 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Jul 14, 2006 8:53 pm
Posts: 654
Location: Malta
This definitely proves that after 20 years I still don't know how to use the 'net :(
Thanks blue

And I was the original author? I thought the code was too elegant for it to be mine

_________________
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 6 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye