; Index Maker for Maps V3.1
; -------------------------
;
; Have you ever wanted to browse your Maps in some form of order?
; Now you can!
; IndexMap can create indexes for your Maps and you supply the sorting function (don't worry its easy!)
; Multiple indexes (as many as you like) can be added to the same Map; its important you use the same group when having mu
; group when having multiple indexes on same Map; and use DIFFERENT groups for different Maps
;
; Share and use freely
;
; Code adapted by KingLestat
; Original code author: An older version of me + scrounging
; Mar/2018
; Updated Nov/2019
;
; May/2020
; Rewrite
;
; - Discovered that my FastDel was only a FastBug!
; - Without groups, when deleting an element it would remain in other indexes
; - Added search function
;
; =========================
Support files (text files for examples)
http://sen3.net/files/textfiles.7z
Code: Select all
; =======================================================================
; Index Maker for Maps V3.1
; -------------------------
;
; Have you ever wanted to browse your Maps in some form of order?
; Now you can!
; IndexMap can create indexes for your Maps and you supply the sorting function (don't worry its easy!)
; Multiple indexes (as many as you like) can be added to the same Map; its important you use the same group when having mu
; group when having multiple indexes on same Map; and use DIFFERENT groups for different Maps
;
; Share and use freely
;
; Code adapted by KingLestat
; Original code author: An older version of me + scrounging
; Mar/2018
; Updated Nov/2019
;
; May/2020
; Rewrite
;
; - Discovered that my FastDel was only a FastBug!
; - Without groups, when deleting an element it would remain in other indexes
; - Added search function
;
; =======================================================================
DeclareModule IndexMap
Prototype CompareFN( *e1, *e2 )
Declare ndxmapCreateIndex( IndexName.s, GroupName.s, fnCompare.CompareFN, ArSize = 0 )
Declare ndxmapAdd( *p )
Declare ndxmapDelete( GroupName.s, *p )
Declare ndxmapClear( groupname.s )
Declare ndxmapSearch( *find, bExact = 0 )
EnableExplicit
; ======================================================================================================
;- Public Constants
; ======================================================================================================
CompilerIf Not Defined( PB_Compiler_Unicode, #PB_Constant )
#PB_Compiler_Unicode = #True
#PB_Compiler_Thread = #True
#SB_Compiler_SpiderBasic = 230
CompilerEndIf
Enumeration
#NDXMAP_RESET = 0
#NDXMAP_FIRST = 1
#NDXMAP_LAST = 2
#NDXMAP_PREV = 3
#NDXMAP_NEXT = 4
#NDXMAP_SIZE = 5
EndEnumeration
#NDXMAP_STANDARD = 16033
#NDXMAP_MEDIUM = 34157
#NDXMAP_LARGE = 68891
#NDXMAP_SMALL = 757
#NDXMAP_EXACT = 1
#NDXMAP_PRIME = #NDXMAP_LARGE
; ======================================================================================================
;- Public Structures
; ======================================================================================================
Structure stIndexDetails
Name.s
Group.s
nCount.l
nSize.l
nGrow.l
nPos.l
fnCompare.CompareFN
Array arIndex.l(0)
EndStructure
; ======================================================================================================
;- Public Macros
; ======================================================================================================
Macro ndxmapSetNDX( indexname )
FindMapElement( mapIndexMap(), indexname )
EndMacro
Macro ndxmapChange( newpos, value )
Select newpos
Case #NDXMAP_FIRST
mapIndexMap()\nPos = 0
value = mapIndexMap()\arIndex(0)
Case #NDXMAP_LAST
mapIndexMap()\nPos = mapIndexMap()\nCount - 1
value = mapIndexMap()\arIndex(mapIndexMap()\nPos)
Case #NDXMAP_NEXT
If value < (mapIndexMap()\nCount - 1)
mapIndexMap()\nPos + 1
value = mapIndexMap()\arIndex(mapIndexMap()\nPos)
Else
value = 0
EndIf
Case #NDXMAP_PREV
If mapIndexMap()\nPos > 0
mapIndexMap()\nPos - 1
value = mapIndexMap()\arIndex(mapIndexMap()\nPos)
Else
value = 0
EndIf
Case #NDXMAP_SIZE
value = mapIndexMap()\nCount
EndSelect
EndMacro
; =====================================================================================
;- Public Globals
; =====================================================================================
Global NewMap mapIndexMap.stIndexDetails(127)
EndDeclareModule
Module IndexMap
; =====================================================================================
;- Private Macros
; =====================================================================================
; =====================================================================================
;- Private Structures
; =====================================================================================
;- to remove
Structure stTest
sText.s
iNum.q
dTest.d
EndStructure
; =====================================================================================
;- Module Functions
; =====================================================================================
; IndexName - A unique name to identify index
; GroupName - Used in deletion; when creating multiple indexes for same map, all keys for all indexes are deleted
; fnCompare - A Procedure which takes 2 elements of the types you want to keep sorted
; ArSize - This keeps a pointer every [SplitSize] elements to make searching faster ( 1 << Search << (DataSet / SplitSize + ~ ) + SplitSize + 1 )
; FastDel - This allows for fast deletions; useful withg large datasets (at a cost of extra overhead when adding + memort consumption )
Procedure ndxmapCreateIndex( IndexName.s, GroupName.s, fnCompare.CompareFN, ArSize = 0 )
Protected szGroup.s = LCase( GroupName )
If FindMapElement( mapIndexMap(), IndexName )
ProcedureReturn -1
EndIf
If ArSize <= 0 : ArSize = 1000 : EndIf
AddMapElement( mapIndexMap(), IndexName )
With mapIndexMap()
\fnCompare = fnCompare
\Name = IndexName
\Group = szGroup
\nSize = ArSize
\nGrow = ArSize >> 1
EndWith
ReDim mapIndexMap()\arIndex(ArSize)
EndProcedure
Procedure ndxmapAdd( *p )
Protected iLow.i, iHigh.i, iMid.i
Protected flag, res, i
If mapIndexMap()\nCount > 0
iHigh = mapIndexMap()\nCount
While iLow < iHigh
If mapIndexMap()\fnCompare( *p, mapIndexMap()\arIndex( iLow ) ) <= 0
Break
ElseIf mapIndexMap()\fnCompare( *p, mapIndexMap()\arIndex( iHigh - 1 ) ) >= 0
iLow = iHigh
Break
Else
iMid = (iLow + iHigh) >> 1
EndIf
res = mapIndexMap()\fnCompare( *p, mapIndexMap()\arIndex( iMid ) )
If res = 0
iLow = iMid
Break
ElseIf res < 0
iHigh = iMid
Else
iLow = iMid + 1
EndIf
Wend
MoveMemory( @mapIndexMap()\arIndex( iLow ), @mapIndexMap()\arIndex( iLow + 1 ), @mapIndexMap()\arIndex( mapIndexMap()\nCount ) - @mapIndexMap()\arIndex( iLow ) )
EndIf
mapIndexMap()\arIndex( iLow ) = *p
mapIndexMap()\nCount + 1
If mapIndexMap()\nCount > mapIndexMap()\nSize
mapIndexMap()\nSize + mapIndexMap()\nGrow
ReDim mapIndexMap()\arIndex( mapIndexMap()\nSize )
EndIf
EndProcedure
Procedure ndxmapDelete( group.s, *p )
Protected i, j, *ptr, flag
Protected NewList llDelete()
group = LCase(group)
ForEach mapIndexMap()
If mapIndexMap()\Group = group
j = 0
ClearList( llDelete() )
For i = 0 To mapIndexMap()\nCount - 1
If *p = mapIndexMap()\arIndex(i)
AddElement( llDelete() )
llDelete() = i - j
j + 1
Break
EndIf
Next
ForEach llDelete()
i = llDelete()
MoveMemory( @mapIndexMap()\arIndex( i + 1 ), @mapIndexMap()\arIndex( i ), @mapIndexMap()\arIndex( mapIndexMap()\nCount ) - @mapIndexMap()\arIndex( i + 1 ) )
mapIndexMap()\nCount - 1
Next
EndIf
Next
EndProcedure
Procedure ndxmapClear( groupname.s )
groupname = LCase( groupname )
ForEach mapIndexMap()
If mapIndexMap()\group = groupname
ReDim mapIndexMap()\arIndex( 0 )
DeleteMapElement( mapIndexMap() )
EndIf
Next
EndProcedure
Procedure ndxmapSearch( *find, bExact = 0 )
Protected iLow.i, iHigh.i, iMid.i
Protected found, res
If mapIndexMap()\nCount > 0
iHigh = mapIndexMap()\nCount
While iLow < iHigh
res = mapIndexMap()\fnCompare( *find, mapIndexMap()\arIndex( iLow ) )
If res = 0
found = mapIndexMap()\arIndex( iLow )
Break
ElseIf res < 0
If bExact
found = 0
Else
found = mapIndexMap()\arIndex( iLow )
EndIf
Break
ElseIf mapIndexMap()\fnCompare( *find, mapIndexMap()\arIndex( iHigh - 1 ) ) > 0
If bExact
found = 0
Else
found = mapIndexMap()\arIndex( iHigh )
EndIf
Break
Else
iMid = (iLow + iHigh) >> 1
EndIf
res = mapIndexMap()\fnCompare( *find, mapIndexMap()\arIndex( iMid ) )
If res = 0
found = mapIndexMap()\arIndex( iMid )
Break
ElseIf res < 0
iHigh = iMid
Else
iLow = iMid + 1
EndIf
Wend
EndIf
ProcedureReturn found
EndProcedure
EndModule
; ======================================================================================================
;- End Index Module
; ======================================================================================================
CompilerIf #PB_Compiler_IsMainFile
CompilerIf #PB_Compiler_Debugger = #False
MessageRequester( "Error", "Switch Debugger on to see the demo.", #PB_MessageRequester_Error )
End
CompilerEndIf
;------------------------
;- Test Code
;------------------------
#MaxSize = 60
UseModule IndexMap
Structure stTest
sText.s
iNum.q
dTest.d
EndStructure
Global NewMap mapTest.stTest(#MaxSize)
Global Dim arString.s(800)
;RandomSeed(1971)
Macro LText( textstr )
"] Txt=" + LSet( textstr, 40 )
EndMacro
Macro ListData( indexname, extra )
Debug "==[ " + indexname + extra + " ]===================================="
ndxmapSetNDX( indexname )
ndxmapChange( #NDXMAP_SIZE, total )
For i = 0 To total - 1
*p = mapIndexMap()\arIndex(i)
If *p
Debug "[" + RSet( Str(i + 1), 3 ) + LText( *p\sText ) + " [" + Str( *p\iNum ) + "] --> " + StrD( *p\dTest, 2 )
Else
Debug "[" + RSet( Str(i + 1), 3 ) + "] <NULL>"
EndIf
Next
Debug "Size: " + Str( total )
EndMacro
Macro FindMyString( searchtxt )
Debug "==[ Find -->" + searchtxt + " ]===================================="
find\sText = searchtxt
*ptr = ndxmapSearch( @find, #NDXMAP_EXACT )
If *ptr
Debug "Exact match found for [" + find\sText + "]"
Else
*p = ndxmapSearch( @find )
If *p
Debug "Closest match for [" + find\sText + "] is [" + *p\sText + "]"
EndIf
EndIf
EndMacro
Procedure ReadTextData()
Protected f, i, format
Protected name.s
f = ReadFile( #PB_Any, "names.txt" )
format = ReadStringFormat( f )
i = 0
While Not Eof(f)
name = Trim( ReadString( f, format ) )
If name > ""
arString(i) = name
i + 1
EndIf
Wend
CloseFile( f )
ReDim arString(i)
RandomizeArray( arString() )
ProcedureReturn i
EndProcedure
Procedure CompareInt( *p1.stTest, *p2.stTest )
ProcedureReturn *p1\iNum - *p2\iNum
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 )
s1.s = LCase( *p1\sText )
s2.s = LCase( *p2\sText )
If s1 < s2
ProcedureReturn -1
ElseIf s1 > s2
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
Define *ptr, *p.stTest, sTookString.s
Define i, j, total
Define l
Define find.stTest
ndxmapCreateIndex( "DoubleFull", "test", @CompareDouble(), 50 )
ndxmapCreateIndex( "String", "test", @CompareString(), 50 )
ndxmapCreateIndex( "Integer", "test", @CompareInt(), 50 )
ndxmapCreateIndex( "Alternate", "test", @CompareString(), 50 ) ; Only 50% of the dataset used
l = ReadTextData() - 1
Debug "==[As Created]===================================="
For iIndex = 0 To #MaxSize - 1
*ptr = AddMapElement( mapTest(), "Key-" + Str(iIndex + 1) )
j = Random( l )
mapTest()\sText = LSet( arString(j), 35 )
mapTest()\iNum = Random( 499, 10 )
mapTest()\dTest = Random(10000, 10) / Random(1000, 100)
Debug "[" + Str(iIndex) + LText( mapTest()\sText ) + " [" + Str( mapTest()\iNum ) + "] --> " + StrD( mapTest()\dTest, 2 )
ndxmapSetNDX( "DoubleFull" )
ndxmapAdd( *ptr )
ndxmapSetNDX( "String" )
ndxmapAdd( *ptr )
ndxmapSetNDX( "Integer" )
ndxmapAdd( *ptr )
If Mod( iIndex + 1, 2 )
ndxmapSetNDX( "Alternate" )
ndxmapAdd( *ptr )
EndIf
Next
ListData( "DoubleFull", "" )
ListData( "String", "" )
ListData( "Alternate", "" )
ListData( "Integer", "" )
Debug "==[Deleting some entries]===================================="
iIndex = 1
j = 0
ForEach mapTest()
If Mod( iIndex, Random(7,4) ) = 0
j + 1
ndxmapDelete( "test", @mapTest() )
Debug "DEL->" + RSet( Str( iIndex ), 2 ) + " " + LText( mapTest()\sText ) + StrD( mapTest()\dTest, 2 )
DeleteMapElement( mapTest() )
EndIf
iIndex + 1
Next
Debug ""
Debug "Total deleted: " + Str(j)
Debug ""
ListData( "Alternate", " (Deleted)" )
ListData( "DoubleFull", " (Deleted)" )
ListData( "String", " (Deleted)" )
ListData( "Integer", " (Deleted)" )
ndxmapSetNDX( "String" )
FindMyString( "Kafka" )
FindMyString( "God" )
FindMyString( "Loki" )
FindMyString( "Nemo" )
FindMyString( "Napoleon" )
CompilerEndIf