' #############################################################################
' ASSOCIATIVE ARRAY / DICTIONARY IMPLEMENTATION
' Version 1.16.00 by madscijr
' BASED OFF SOME DISCUSSION AT
' associative arrays / dictionaries in QB64?
' https://www.qb64.org/forum/index.php?topic=3387.0
' -----------------------------------------------------------------------------
' Description
' -----------------------------------------------------------------------------
' Tries to emulate a simple dictionary / associative array in QB64.
' -----------------------------------------------------------------------------
' Customizing
' -----------------------------------------------------------------------------
' Stores mixed data types with a user defined type DictionaryType,
' which you can change as needed, as long as you leave the
' properties Key and NextFree:
' TYPE DictionaryType
' Key AS String
' NextFree As Long
' (your values here)
' END TYPE
' You will need to update DumpDictionary so the properties match
' whatever you have in the type.
' There is a global constant
' CONST cIntDictMax = 0
' which can be used to define a maximum number of nodes to be stored.
' If the value is 0 then there is no maximum.
' -----------------------------------------------------------------------------
' How to use
' -----------------------------------------------------------------------------
' To use the dictionary, you just declare an array of DictionaryType,
' where array(0) is reserved, so don't declare your array 1 To n,
' it must start with index 0.
' The following functions are available:
' 1. InitDictionary initializes a new dictionary.
' Receives one parameter:
' arrDict: the array of DictionaryType
' Usage:
' InitDictionary arrDict()
' 2. SaveDictionary& writes a value to the dictionary.
' Receives two parameters:
' arrDict: the array of DictionaryType
' MyValue: a variable of type DictionaryType
' where MyValue.Key holds the key
' and MyMalue.{property} holds value(s) to store.
' Returns the array index the item is stored at,
' or 0 if the save failed.
' Usage:
' lngIndex = SaveDictionary&(arrDict(), MyValue)
' 3. DeleteDictionaryKey removes a value from the dictionary.
' Receives two parameters:
' arrDict: the array of DictionaryType
' sKey: the key of the item to be deleted
' Returns TRUE if the key is found and the item is deleted,
' or FALSE if the key was not found.
' Items are logically deleted and reused for future inserts
' (see below for details if you want to know how it works).
' Usage:
' bResult = DeleteDictionaryKey%(arrDict(), sKey)
' 4. FindDictionaryKey searches the dictionary for a given key.
' Receives two parameters:
' arrDict: the array of DictionaryType
' sKey: the key of the item to be found
' Returns the array index the item was found at,
' or 0 if the key was not found.
' Usage:
' lngIndex = FindDictionaryKey&(arrDict(), sKey)
' 5. DumpDictionary returns a verbose string with the
' dictionary contents. If you change DictionaryType
' you will need to update this function to reflect
' the changes.
' Receives one parameter:
' arrDict: the array of DictionaryType
' Returns a multi-line string containing the
' contents of the dictionary.
' Usage:
' MyString = DumpDictionary$(arrDict())
' -----------------------------------------------------------------------------
' Some limitations
' -----------------------------------------------------------------------------
' 1. Not the most efficient - simply appends new keys to the end of the array,
' and searches for them in linear order).
' We can try a hashing method similar to Luke's symtab code at
' Re: associative arrays / dictionaries in QB64?
' https://www.qb64.org/forum/index.php?topic=3387.msg127022#msg127022
' or try adding the keys in sorted order (will have to experiment).
' 2. No sorting.
' -----------------------------------------------------------------------------
' Updates
' -----------------------------------------------------------------------------
' * Logical delete = faster!
'
' Uses the logical delete method for the linked list implementation at
' https://www.qb64.org/forum/index.php?topic=4008.0
'
' The way it works is:
' We don't delete nodes from the dictionary, just reuse them.
' Each node has a .NextFree property that points to the index of
' the next array item to be reused.
' Array item(0) is reserved for tracking the first free item.
' When a node is "deleted", we set array(0).NextFree to the index of the deleted node.
' When we delete subsequent nodes, each one's .NextFree points to the next available
' deleted node in a "chain". When we reuse the next given node,
' we repoint array(0).NextFree to the next one, and so array(0).NextFree
' always points to the next available node to be reused.
'
' If array(0).NextFree = 0, then there are no deleted nodes to be reused,
' so we append a new element to the array with REDIM _PRESERVE.
'
' array(0) is the head of the "deleted" or "to be reused" chain.
'
' * Returns 0 for failed instead of -1, to match the value FALSE.
' -----------------------------------------------------------------------------
' Questions
' -----------------------------------------------------------------------------
' 1. What are some other ways this could be better implemented?
' 2. Would it be more efficient if we inserted elements in sort order,
' so the dictionary is always sorted? That would speed up read
' (which would find the key with a binary search) but slow down write.
' How do we implement this?
' 3. If we added a sort function, to sort by value OR key,
' Which algorithm would be fast (but not too complex to debug &
' understand) for integer values? For string values?
' #############################################################################
' =============================================================================
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
' =============================================================================
' CONSTANTS
' =============================================================================
Const cIntDictMax
= 0 ' lets us limit the size of the dictionary, 0=no limit
' =============================================================================
' USER DEFINED TYPES
' =============================================================================
NextFree
As Long ' pointer to next free node (0 means none, we redim array)
' =============================================================================
' GLOBAL VARIABLES
' =============================================================================
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
'$Console
'_Delay 4
'_Console On
'_Echo "Started " + ProgramName$
'_Echo "Debugging on..."
' ****************************************************************************************************************************************************************
' =============================================================================
' LOCAL VARIABLES
' =============================================================================
' RUN TEST
main
' =============================================================================
' FINISH
Print ProgramName$
+ " finished." Input "PRESS <ENTER> TO EXIT", in$
System ' return control to the operating system
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
'_Console Off
' ****************************************************************************************************************************************************************
' /////////////////////////////////////////////////////////////////////////////
Dim MyValue
As DictionaryType
Print "-------------------------------------------------------------------------------" Print "Initializing dictionary..." InitDictionary arrDict()
PrintPaged DumpDictionary$(arrDict()), 20
Print "-------------------------------------------------------------------------------" Print "Writing some values..." Input "Press <ENTER> to write some values", in$
MyValue.intValue = 3:
MyValue.strValue = "a":
MyValue.lngValue = 33:
lngIndex = SaveDictionary&(arrDict(), MyValue)
Print "SaveDictionary& for key " + Chr$(34) + MyValue.
Key + Chr$(34) + " returns " + cstrl$
(lngIndex
)
MyValue.intValue = 1:
MyValue.strValue = "b":
MyValue.lngValue = 11:
lngIndex = SaveDictionary&(arrDict(), MyValue)
Print "SaveDictionary& for key " + Chr$(34) + MyValue.
Key + Chr$(34) + " returns " + cstrl$
(lngIndex
)
MyValue.intValue = 0:
MyValue.strValue = "c":
MyValue.lngValue = -1:
lngIndex = SaveDictionary&(arrDict(), MyValue)
Print "SaveDictionary& for key " + Chr$(34) + MyValue.
Key + Chr$(34) + " returns " + cstrl$
(lngIndex
)
MyValue.
Key = "xylophone" MyValue.intValue = 2:
MyValue.strValue = "d":
MyValue.lngValue = 22:
lngIndex = SaveDictionary&(arrDict(), MyValue)
Print "SaveDictionary& for key " + Chr$(34) + MyValue.
Key + Chr$(34) + " returns " + cstrl$
(lngIndex
)
MyValue.intValue = 4:
MyValue.strValue = "e":
MyValue.lngValue = 44:
lngIndex = SaveDictionary&(arrDict(), MyValue)
Print "SaveDictionary& for key " + Chr$(34) + MyValue.
Key + Chr$(34) + " returns " + cstrl$
(lngIndex
)
Input "Press <ENTER> to view contents.", in$
PrintPaged DumpDictionary$(arrDict()), 20
Print "-------------------------------------------------------------------------------" Print "Deleting some keys..." Input "Press <ENTER> to test delete function.", in$
sKey = "zebra"
bResult = DeleteDictionaryKey%(arrDict(), sKey)
Print "DeleteDictionaryKey%(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + IIFSTR$
(bResult
, "TRUE", "FALSE")
sKey = "nonesuch"
bResult = DeleteDictionaryKey%(arrDict(), sKey)
Print "DeleteDictionaryKey%(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + IIFSTR$
(bResult
, "TRUE", "FALSE")
sKey = "xylophone"
bResult = DeleteDictionaryKey%(arrDict(), sKey)
Print "DeleteDictionaryKey%(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + IIFSTR$
(bResult
, "TRUE", "FALSE")
Input "Press <ENTER> to view contents.", in$
PrintPaged DumpDictionary$(arrDict()), 20
Print "-------------------------------------------------------------------------------" Input "Press <ENTER> to test search function.", in$
sKey = "africa"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + cstr$
(lngIndex
)
sKey = "xenophobe"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + cstr$
(lngIndex
)
sKey = "APPLE"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + cstr$
(lngIndex
)
sKey = "zambia"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34) + ") returns " + cstr$
(lngIndex
)
Input "Press <ENTER> to view contents.", in$
PrintPaged DumpDictionary$(arrDict()), 20
Print "-------------------------------------------------------------------------------" Print "Retrieving values..."
Input "Press <ENTER> to view contents of 'africa'", in$
sKey = "africa"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34);
" ) returns " + cstrl$
(lngIndex
) Print " .intValue=" + cstr$
(arrDict
(lngIndex
).intValue
) Print " .strValue=" + Chr$(34) + arrDict
(lngIndex
).strValue
+ Chr$(34) Print " .lngValue=" + cstrl$
(arrDict
(lngIndex
).lngValue
) Print " .NextFree=" + cstrl$
(arrDict
(lngIndex
).NextFree
)
Input "Press <ENTER> to view contents of 'zebra'", in$
sKey = "zebra"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34);
" ) returns " + cstrl$
(lngIndex
) Print " .intValue=" + cstr$
(arrDict
(lngIndex
).intValue
) Print " .strValue=" + Chr$(34) + arrDict
(lngIndex
).strValue
+ Chr$(34) Print " .lngValue=" + cstrl$
(arrDict
(lngIndex
).lngValue
) Print " .NextFree=" + cstrl$
(arrDict
(lngIndex
).NextFree
)
Input "Press <ENTER> to view contents of 'apple'", in$
sKey = "apple"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34);
" ) returns " + cstrl$
(lngIndex
) Print " .intValue=" + cstr$
(arrDict
(lngIndex
).intValue
) Print " .strValue=" + Chr$(34) + arrDict
(lngIndex
).strValue
+ Chr$(34) Print " .lngValue=" + cstrl$
(arrDict
(lngIndex
).lngValue
) Print " .NextFree=" + cstrl$
(arrDict
(lngIndex
).NextFree
)
Input "Press <ENTER> to view contents of 'nonesuch'", in$
sKey = "nonesuch"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34);
" ) returns " + cstrl$
(lngIndex
) Print " .intValue=" + cstr$
(arrDict
(lngIndex
).intValue
) Print " .strValue=" + Chr$(34) + arrDict
(lngIndex
).strValue
+ Chr$(34) Print " .lngValue=" + cstrl$
(arrDict
(lngIndex
).lngValue
) Print " .NextFree=" + cstrl$
(arrDict
(lngIndex
).NextFree
)
Input "Press <ENTER> to view contents of 'xylophone'", in$
sKey = "xylophone"
lngIndex = FindDictionaryKey&(arrDict(), sKey)
Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey
+ Chr$(34);
" ) returns " + cstrl$
(lngIndex
) Print " .intValue=" + cstr$
(arrDict
(lngIndex
).intValue
) Print " .strValue=" + Chr$(34) + arrDict
(lngIndex
).strValue
+ Chr$(34) Print " .lngValue=" + cstrl$
(arrDict
(lngIndex
).lngValue
) Print " .NextFree=" + cstrl$
(arrDict
(lngIndex
).NextFree
)
Input "Press <ENTER> to view contents.", in$
PrintPaged DumpDictionary$(arrDict()), 20
Print "-------------------------------------------------------------------------------" Print "This concludes the test of the pseudo-associative array / dictionary." Input "PRESS <ENTER> TO CONTINUE", in$
' /////////////////////////////////////////////////////////////////////////////
Sub PrintPaged
(MyString$
, iLinesPerPage%
) 'Dim iRow%
split MyString$, delim$, arrTest$()
iCount% = 0
iCount% = iCount% + 1
If iCount%
> iLinesPerPage%
Then 'iRow% = CSRLIN ' save the row
'INPUT "PRESS <ENTER> TO CONTINUE";in$
'LOCATE iRow% - 1, 0 ' restore saved position
iCount% = 0
' /////////////////////////////////////////////////////////////////////////////
Input "Press <ENTER> to continue", in$
' /////////////////////////////////////////////////////////////////////////////
Sub InitDictionary
(arrDict
() As DictionaryType
) arrDict(0).NextFree = 0
' /////////////////////////////////////////////////////////////////////////////
Function SaveDictionary&
(arrDict
() As DictionaryType
, MyValue
As DictionaryType
)
' LOOK FOR KEY
lngIndex = 0
lngIndex = lngLoop
' IF NOT FOUND THEN ADD IT
' SEE IF THERE IS A NODE WE CAN REUSE
lngIndex = arrDict(0).NextFree
' REUSE NODE - POINT HEAD TO NEXT FREE (IF THERE IS ONE)
arrDict(0).NextFree = arrDict(lngIndex).NextFree
arrDict(lngIndex).NextFree = 0
' NONE FREE - EXPAND ARRAY
lngIndex
= UBound(arrDict
) + 1
' IS THERE A SIZE LIMIT?
' IS THERE ROOM?
If (lngIndex
> cIntDictMax
) Then ' DICTIONARY FULL!
' SET lngIndex TO 0 WHICH INDICATES FAILURE
lngIndex = 0
' OK TO ADD NEW ELEMENT
arrDict
(lngIndex
).
Key = MyValue.
Key arrDict(lngIndex).NextFree = 0
' UPDATE VALUE IF NO ERRORS
arrDict(lngIndex).intValue = MyValue.intValue
arrDict(lngIndex).strValue = MyValue.strValue
arrDict(lngIndex).lngValue = MyValue.lngValue
' RETURN THE INDEX (OR 0 IF NOT ADDED)
SaveDictionary& = lngIndex
' /////////////////////////////////////////////////////////////////////////////
lngIndex = 0
lngIndex = lngLoop
FindDictionaryKey& = lngIndex
' /////////////////////////////////////////////////////////////////////////////
lngIndex = FindDictionaryKey&(arrDict(), sKey)
' clear the key
arrDict
(lngIndex
).
Key = ""
' do we have any deleted nodes?
If arrDict
(0).NextFree
> 0 Then ' insert current node at the top of the "deleted" chain
arrDict(lngIndex).NextFree = arrDict(0).NextFree
' soft delete
arrDict(0).NextFree = lngIndex
' return true (found and deleted)
DeleteDictionaryKey% = TRUE
' return false (not found)
DeleteDictionaryKey% = FALSE
' /////////////////////////////////////////////////////////////////////////////
Function DumpDictionary$
(arrDict
() As DictionaryType
)
' CREATE A LIST OF DELETED ITEMS
iPos = 0
While arrDict
(iPos
).NextFree
> 0 iPos = arrDict(iPos).NextFree
sDeleted
= sDeleted
+ arrDict
(iPos
).
Key + ","
' DUMP ALL ITEMS
sResult
= sResult
+ "Dictionary size: " + cstr$
(UBound(arrDict
) + 1) + Chr$(13) sResult
= sResult
+ "Item(" + cstrl$
(lngLoop
) + ")" + Chr$(13) sResult
= sResult
+ "*DELETED* Item(" + cstrl$
(lngLoop
) + ")" + Chr$(13) sResult
= sResult
+ " .Key =" + Chr$(34) + arrDict
(lngLoop
).
Key + Chr$(34) + Chr$(13) sResult
= sResult
+ " .IntValue=" + cstr$
(arrDict
(lngLoop
).intValue
) + Chr$(13) sResult
= sResult
+ " .lngValue=" + cstrl$
(arrDict
(lngLoop
).lngValue
) + Chr$(13) sResult
= sResult
+ " .strValue=" + Chr$(34) + arrDict
(lngLoop
).strValue
+ Chr$(34) + Chr$(13) sResult
= sResult
+ " .NextFree=" + cstrl$
(arrDict
(lngLoop
).NextFree
) + Chr$(13) sResult
= sResult
+ Chr$(13)
sResult
= sResult
+ Chr$(13) sResult
= sResult
+ "First deleted: " + cstrl$
(arrDict
(0).NextFree
) + Chr$(13)
' RETURN RESULTS
DumpDictionary$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
result$ = result$ + delimiter$ + in$(i)
join$ = result$
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split
(in$
, delimiter$
, result$
())
iDelimLen
= Len(delimiter$
)
start = 1
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$
, start
, iDelimLen
) = delimiter$
'start = start + 1
start = start + iDelimLen
finish
= InStr(start
, in$
, delimiter$
)
result$
(UBound(result$
)) = Mid$(in$
, start
, finish
- start
) start = finish + 1
' /////////////////////////////////////////////////////////////////////////////
in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
split in$, delim$, arrTest$()
Print "Split test finished."
' /////////////////////////////////////////////////////////////////////////////