multivalue dictionary + demo (v1.16.00)

[madscijr]

This improves on the work here to implement a dictionary in QB64
https://www.qb64.org/forum/index.php?topic=3387.0

and adds some enhancements

• uses a UDT to store multiple values
• simpler command set (maybe too simple!)
• logical delete = much faster

In the future maybe it can use a hash or sorted keys to speed it up.

But it works pretty well for smaller collections of data.

Hopefully someone will find this useful...

Code: QB64: [Select]

1. ' #############################################################################
2. ' ASSOCIATIVE ARRAY / DICTIONARY IMPLEMENTATION
3. ' Version 1.16.00 by madscijr
4.  
5. ' BASED OFF SOME DISCUSSION AT
6. '     associative arrays / dictionaries in QB64?
7. '     https://www.qb64.org/forum/index.php?topic=3387.0
8.  
9. ' -----------------------------------------------------------------------------
10. ' Description
11. ' -----------------------------------------------------------------------------
12. ' Tries to emulate a simple dictionary / associative array in QB64.
13.  
14. ' -----------------------------------------------------------------------------
15. ' Customizing
16. ' -----------------------------------------------------------------------------
17. ' Stores mixed data types with a user defined type DictionaryType,
18. ' which you can change as needed, as long as you leave the
19. ' properties Key and NextFree:
20. '     TYPE DictionaryType
21. '         Key AS String
22. '         NextFree As Long
23. '         (your values here)
24. '     END TYPE
25. ' You will need to update DumpDictionary so the properties match
26. ' whatever you have in the type.
27.  
28. ' There is a global constant
29. '     CONST cIntDictMax = 0
30. ' which can be used to define a maximum number of nodes to be stored.
31. ' If the value is 0 then there is no maximum.
32.  
33. ' -----------------------------------------------------------------------------
34. ' How to use
35. ' -----------------------------------------------------------------------------
36. ' To use the dictionary, you just declare an array of DictionaryType,
37. ' where array(0) is reserved, so don't declare your array 1 To n,
38. ' it must start with index 0.
39.  
40. ' The following functions are available:
41. ' 1. InitDictionary initializes a new dictionary.
42. '    Receives one parameter:
43. '        arrDict: the array of DictionaryType
44. '    Usage:
45. '        InitDictionary arrDict()
46. ' 2. SaveDictionary& writes a value to the dictionary.
47. '    Receives two parameters:
48. '        arrDict: the array of DictionaryType
49. '        MyValue: a variable of type DictionaryType
50. '                 where MyValue.Key holds the key
51. '                 and MyMalue.{property} holds value(s) to store.
52. '    Returns the array index the item is stored at,
53. '    or 0 if the save failed.
54. '    Usage:
55. '        lngIndex = SaveDictionary&(arrDict(), MyValue)
56. ' 3. DeleteDictionaryKey removes a value from the dictionary.
57. '    Receives two parameters:
58. '        arrDict: the array of DictionaryType
59. '        sKey: the key of the item to be deleted
60. '    Returns TRUE if the key is found and the item is deleted,
61. '    or FALSE if the key was not found.
62. '    Items are logically deleted and reused for future inserts
63. '    (see below for details if you want to know how it works).
64. '    Usage:
65. '        bResult = DeleteDictionaryKey%(arrDict(), sKey)
66. ' 4. FindDictionaryKey searches the dictionary for a given key.
67. '    Receives two parameters:
68. '        arrDict: the array of DictionaryType
69. '        sKey: the key of the item to be found
70. '    Returns the array index the item was found at,
71. '    or 0 if the key was not found.
72. '    Usage:
73. '        lngIndex = FindDictionaryKey&(arrDict(), sKey)
74. ' 5. DumpDictionary returns a verbose string with the
75. '    dictionary contents. If you change DictionaryType
76. '    you will need to update this function to reflect
77. '    the changes.
78. '    Receives one parameter:
79. '        arrDict: the array of DictionaryType
80. '    Returns a multi-line string containing the
81. '    contents of the dictionary.
82. '    Usage:
83. '        MyString = DumpDictionary$(arrDict())
84.  
85. ' -----------------------------------------------------------------------------
86. ' Some limitations
87. ' -----------------------------------------------------------------------------
88. ' 1. Not the most efficient - simply appends new keys to the end of the array,
89. '    and searches for them in linear order).
90. '    We can try a hashing method similar to Luke's symtab code at
91. '        Re: associative arrays / dictionaries in QB64?
92. '        https://www.qb64.org/forum/index.php?topic=3387.msg127022#msg127022
93. '    or try adding the keys in sorted order (will have to experiment).
94. ' 2. No sorting.
95.  
96. ' -----------------------------------------------------------------------------
97. ' Updates
98. ' -----------------------------------------------------------------------------
99. ' * Logical delete = faster!
100. '
101. '   Uses the logical delete method for the linked list implementation at
102. '   https://www.qb64.org/forum/index.php?topic=4008.0
103. '
104. '   The way it works is:
105. '   We don't delete nodes from the dictionary, just reuse them.
106. '   Each node has a .NextFree property that points to the index of
107. '   the next array item to be reused.
108. '   Array item(0) is reserved for tracking the first free item.
109. '   When a node is "deleted", we set array(0).NextFree to the index of the deleted node.
110. '   When we delete subsequent nodes, each one's .NextFree points to the next available
111. '   deleted node in a "chain". When we reuse the next given node,
112. '   we repoint array(0).NextFree to the next one, and so array(0).NextFree
113. '   always points to the next available node to be reused.
114. '
115. '   If array(0).NextFree = 0, then there are no deleted nodes to be reused,
116. '   so we append a new element to the array with REDIM _PRESERVE.
117. '
118. '   array(0) is the head of the "deleted" or "to be reused" chain.
119. '
120. ' * Returns 0 for failed instead of -1, to match the value FALSE.
121.  
122. ' -----------------------------------------------------------------------------
123. ' Questions
124. ' -----------------------------------------------------------------------------
125. ' 1. What are some other ways this could be better implemented?
126. ' 2. Would it be more efficient if we inserted elements in sort order,
127. '    so the dictionary is always sorted? That would speed up read
128. '    (which would find the key with a binary search) but slow down write.
129. '    How do we implement this?
130. ' 3. If we added a sort function, to sort by value OR key,
131. '    Which algorithm would be fast (but not too complex to debug &
132. '    understand) for integer values? For string values?
133.  
134. ' #############################################################################
135.  
136. ' =============================================================================
137. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
138.  
139. ' =============================================================================
140. ' CONSTANTS
141. ' =============================================================================
142. Const FALSE = 0
143. Const TRUE = Not FALSE
144.  
145. Const cIntDictMax = 0 ' lets us limit the size of the dictionary, 0=no limit
146.  
147. ' =============================================================================
148. ' USER DEFINED TYPES
149. ' =============================================================================
150. Type DictionaryType
151.     Key As String
152.     intValue As Integer
153.     strValue As String
154.     lngValue As Long
155.     NextFree As Long ' pointer to next free node (0 means none, we redim array)
156. End Type ' DictionaryType
157.  
158. ' =============================================================================
159. ' GLOBAL VARIABLES
160. ' =============================================================================
161. Dim Shared ProgramPath$: ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
162. Dim Shared ProgramName$: ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
163.  
164. ' ****************************************************************************************************************************************************************
165. ' ACTIVATE DEBUGGING WINDOW
166. '$Console
167. '_Delay 4
168. '_Console On
169. '_Echo "Started " + ProgramName$
170. '_Echo "Debugging on..."
171. ' ****************************************************************************************************************************************************************
172.  
173. ' =============================================================================
174. ' LOCAL VARIABLES
175. Dim in$
176.  
177. ' =============================================================================
178. ' RUN TEST
179. main
180.  
181. ' =============================================================================
182. ' FINISH
183. Print ProgramName$ + " finished."
184. Input "PRESS <ENTER> TO EXIT", in$
185. System ' return control to the operating system
186.  
187. ' ****************************************************************************************************************************************************************
188. ' DEACTIVATE DEBUGGING WINDOW
189. '_Console Off
190. ' ****************************************************************************************************************************************************************
191.  
192. End
193.  
194. ' /////////////////////////////////////////////////////////////////////////////
195.  
196. Sub main ()
197.     ReDim arrDict(0) As DictionaryType
198.     Dim MyValue As DictionaryType
199.     Dim lngIndex As Long
200.     Dim sKey As String
201.     Dim bResult As Integer
202.     Dim in$
203.  
204.     Cls
205.  
206.     Print "-------------------------------------------------------------------------------"
207.     Print "Initializing dictionary..."
208.     InitDictionary arrDict()
209.  
210.     Print
211.     PrintPaged DumpDictionary$(arrDict()), 20
212.     Print
213.  
214.     Print "-------------------------------------------------------------------------------"
215.     Print "Writing some values..."
216.     Print
217.     Input "Press <ENTER> to write some values", in$
218.     Print
219.  
220.     MyValue.Key = "apple"
221.     MyValue.intValue = 3:
222.     MyValue.strValue = "a":
223.     MyValue.lngValue = 33:
224.     lngIndex = SaveDictionary&(arrDict(), MyValue)
225.     Print "SaveDictionary& for key " + Chr$(34) + MyValue.Key + Chr$(34) + " returns " + cstrl$(lngIndex)
226.  
227.     MyValue.Key = "africa"
228.     MyValue.intValue = 1:
229.     MyValue.strValue = "b":
230.     MyValue.lngValue = 11:
231.     lngIndex = SaveDictionary&(arrDict(), MyValue)
232.     Print "SaveDictionary& for key " + Chr$(34) + MyValue.Key + Chr$(34) + " returns " + cstrl$(lngIndex)
233.  
234.     MyValue.Key = "zebra"
235.     MyValue.intValue = 0:
236.     MyValue.strValue = "c":
237.     MyValue.lngValue = -1:
238.     lngIndex = SaveDictionary&(arrDict(), MyValue)
239.     Print "SaveDictionary& for key " + Chr$(34) + MyValue.Key + Chr$(34) + " returns " + cstrl$(lngIndex)
240.  
241.     MyValue.Key = "xylophone"
242.     MyValue.intValue = 2:
243.     MyValue.strValue = "d":
244.     MyValue.lngValue = 22:
245.     lngIndex = SaveDictionary&(arrDict(), MyValue)
246.     Print "SaveDictionary& for key " + Chr$(34) + MyValue.Key + Chr$(34) + " returns " + cstrl$(lngIndex)
247.  
248.     MyValue.Key = "zebra"
249.     MyValue.intValue = 4:
250.     MyValue.strValue = "e":
251.     MyValue.lngValue = 44:
252.     lngIndex = SaveDictionary&(arrDict(), MyValue)
253.     Print "SaveDictionary& for key " + Chr$(34) + MyValue.Key + Chr$(34) + " returns " + cstrl$(lngIndex)
254.  
255.     Print
256.     Input "Press <ENTER> to view contents.", in$
257.     Print
258.     PrintPaged DumpDictionary$(arrDict()), 20
259.  
260.     Print "-------------------------------------------------------------------------------"
261.     Print "Deleting some keys..."
262.     Print
263.     Input "Press <ENTER> to test delete function.", in$
264.     Print
265.  
266.     sKey = "zebra"
267.     bResult = DeleteDictionaryKey%(arrDict(), sKey)
268.     Print "DeleteDictionaryKey%(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
269.  
270.     sKey = "nonesuch"
271.     bResult = DeleteDictionaryKey%(arrDict(), sKey)
272.     Print "DeleteDictionaryKey%(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
273.  
274.     sKey = "xylophone"
275.     bResult = DeleteDictionaryKey%(arrDict(), sKey)
276.     Print "DeleteDictionaryKey%(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
277.  
278.     Print
279.     Input "Press <ENTER> to view contents.", in$
280.     Print
281.     PrintPaged DumpDictionary$(arrDict()), 20
282.     Print
283.  
284.     Print "-------------------------------------------------------------------------------"
285.     Print "Look for keys..."
286.     Print
287.     Input "Press <ENTER> to test search function.", in$
288.     Print
289.  
290.     sKey = "africa"
291.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
292.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + cstr$(lngIndex)
293.  
294.     sKey = "xenophobe"
295.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
296.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + cstr$(lngIndex)
297.  
298.     sKey = "APPLE"
299.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
300.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + cstr$(lngIndex)
301.  
302.     sKey = "zambia"
303.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
304.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34) + ") returns " + cstr$(lngIndex)
305.  
306.     Print
307.     Input "Press <ENTER> to view contents.", in$
308.     Print
309.     PrintPaged DumpDictionary$(arrDict()), 20
310.     Print
311.  
312.     Print "-------------------------------------------------------------------------------"
313.     Print "Retrieving values..."
314.  
315.     Print
316.     Input "Press <ENTER> to view contents of 'africa'", in$
317.     Print
318.  
319.     sKey = "africa"
320.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
321.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34); " ) returns " + cstrl$(lngIndex)
322.     If lngIndex > 0 Then
323.         Print "    .Key=" + Chr$(34) + arrDict(lngIndex).Key + Chr$(34)
324.         Print "    .intValue=" + cstr$(arrDict(lngIndex).intValue)
325.         Print "    .strValue=" + Chr$(34) + arrDict(lngIndex).strValue + Chr$(34)
326.         Print "    .lngValue=" + cstrl$(arrDict(lngIndex).lngValue)
327.         Print "    .NextFree=" + cstrl$(arrDict(lngIndex).NextFree)
328.     End If
329.  
330.     Print
331.     Input "Press <ENTER> to view contents of 'zebra'", in$
332.     Print
333.  
334.     sKey = "zebra"
335.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
336.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34); " ) returns " + cstrl$(lngIndex)
337.     If lngIndex > 0 Then
338.         Print "    .Key=" + Chr$(34) + arrDict(lngIndex).Key + Chr$(34)
339.         Print "    .intValue=" + cstr$(arrDict(lngIndex).intValue)
340.         Print "    .strValue=" + Chr$(34) + arrDict(lngIndex).strValue + Chr$(34)
341.         Print "    .lngValue=" + cstrl$(arrDict(lngIndex).lngValue)
342.         Print "    .NextFree=" + cstrl$(arrDict(lngIndex).NextFree)
343.     End If
344.  
345.     Print
346.     Input "Press <ENTER> to view contents of 'apple'", in$
347.     Print
348.  
349.     sKey = "apple"
350.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
351.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34); " ) returns " + cstrl$(lngIndex)
352.     If lngIndex > 0 Then
353.         Print "    .Key=" + Chr$(34) + arrDict(lngIndex).Key + Chr$(34)
354.         Print "    .intValue=" + cstr$(arrDict(lngIndex).intValue)
355.         Print "    .strValue=" + Chr$(34) + arrDict(lngIndex).strValue + Chr$(34)
356.         Print "    .lngValue=" + cstrl$(arrDict(lngIndex).lngValue)
357.         Print "    .NextFree=" + cstrl$(arrDict(lngIndex).NextFree)
358.     End If
359.  
360.     Print
361.     Input "Press <ENTER> to view contents of 'nonesuch'", in$
362.     Print
363.  
364.     sKey = "nonesuch"
365.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
366.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34); " ) returns " + cstrl$(lngIndex)
367.     If lngIndex > 0 Then
368.         Print "    .Key=" + Chr$(34) + arrDict(lngIndex).Key + Chr$(34)
369.         Print "    .intValue=" + cstr$(arrDict(lngIndex).intValue)
370.         Print "    .strValue=" + Chr$(34) + arrDict(lngIndex).strValue + Chr$(34)
371.         Print "    .lngValue=" + cstrl$(arrDict(lngIndex).lngValue)
372.         Print "    .NextFree=" + cstrl$(arrDict(lngIndex).NextFree)
373.     End If
374.  
375.     Print
376.     Input "Press <ENTER> to view contents of 'xylophone'", in$
377.     Print
378.  
379.     sKey = "xylophone"
380.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
381.     Print "FindDictionaryKey&(arrDict(), " + Chr$(34) + sKey + Chr$(34); " ) returns " + cstrl$(lngIndex)
382.     If lngIndex > 0 Then
383.         Print "    .Key=" + Chr$(34) + arrDict(lngIndex).Key + Chr$(34)
384.         Print "    .intValue=" + cstr$(arrDict(lngIndex).intValue)
385.         Print "    .strValue=" + Chr$(34) + arrDict(lngIndex).strValue + Chr$(34)
386.         Print "    .lngValue=" + cstrl$(arrDict(lngIndex).lngValue)
387.         Print "    .NextFree=" + cstrl$(arrDict(lngIndex).NextFree)
388.     End If
389.  
390.     Print
391.     Input "Press <ENTER> to view contents.", in$
392.     Print
393.     PrintPaged DumpDictionary$(arrDict()), 20
394.     Print
395.  
396.     Print "-------------------------------------------------------------------------------"
397.     Print "This concludes the test of the pseudo-associative array / dictionary."
398.     Print
399.     Input "PRESS <ENTER> TO CONTINUE", in$
400.  
401. End Sub ' main
402.  
403. ' /////////////////////////////////////////////////////////////////////////////
404.  
405. Sub PrintPaged (MyString$, iLinesPerPage%)
406.     Dim delim$
407.     ReDim arrTest$(0)
408.     Dim iLoop%
409.     Dim iCount%
410.     'Dim iRow%
411.     Dim in$
412.  
413.     delim$ = Chr$(13)
414.     split MyString$, delim$, arrTest$()
415.  
416.     iCount% = 0
417.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
418.         iCount% = iCount% + 1
419.         If iCount% > iLinesPerPage% Then
420.             'iRow% = CSRLIN ' save the row
421.             'INPUT "PRESS <ENTER> TO CONTINUE";in$
422.             'LOCATE iRow% - 1, 0 ' restore saved position
423.             Sleep
424.             iCount% = 0
425.         End If
426.         Print arrTest$(iLoop%)
427.     Next iLoop%
428.  
429. End Sub ' PrintPaged
430.  
431. ' /////////////////////////////////////////////////////////////////////////////
432.  
433. Sub WaitForEnter
434.     Dim in$
435.     Input "Press <ENTER> to continue", in$
436. End Sub ' WaitForEnter
437.  
438. ' /////////////////////////////////////////////////////////////////////////////
439.  
440. Sub InitDictionary (arrDict() As DictionaryType)
441.     ReDim arrDict(0) As DictionaryType
442.     arrDict(0).NextFree = 0
443. End Sub ' InitDictionary
444.  
445. ' /////////////////////////////////////////////////////////////////////////////
446.  
447. Function SaveDictionary& (arrDict() As DictionaryType, MyValue As DictionaryType)
448.     Dim lngLoop As Long
449.     Dim lngIndex As Long
450.  
451.     ' LOOK FOR KEY
452.     lngIndex = 0
453.     For lngLoop = 0 To UBound(arrDict)
454.         If LCase$(arrDict(lngLoop).Key) = LCase$(MyValue.Key) Then
455.             lngIndex = lngLoop
456.             Exit For
457.         End If
458.     Next lngLoop
459.  
460.     ' IF NOT FOUND THEN ADD IT
461.     If (lngIndex < 1) Then
462.         ' SEE IF THERE IS A NODE WE CAN REUSE
463.         lngIndex = arrDict(0).NextFree
464.         If lngIndex > 0 Then
465.             ' REUSE NODE - POINT HEAD TO NEXT FREE (IF THERE IS ONE)
466.             arrDict(0).NextFree = arrDict(lngIndex).NextFree
467.             arrDict(lngIndex).NextFree = 0
468.         Else
469.             ' NONE FREE - EXPAND ARRAY
470.             lngIndex = UBound(arrDict) + 1
471.  
472.             ' IS THERE A SIZE LIMIT?
473.             If (cIntDictMax > 0) Then
474.                 ' IS THERE ROOM?
475.                 If (lngIndex > cIntDictMax) Then
476.                     ' DICTIONARY FULL!
477.                     ' SET lngIndex TO 0 WHICH INDICATES FAILURE
478.                     lngIndex = 0
479.                 End If
480.             End If
481.  
482.             ' OK TO ADD NEW ELEMENT
483.             If lngIndex > 0 Then
484.                 ReDim _Preserve arrDict(lngIndex) As DictionaryType
485.                 arrDict(lngIndex).Key = MyValue.Key
486.                 arrDict(lngIndex).NextFree = 0
487.             End If
488.         End If
489.     End If
490.  
491.     ' UPDATE VALUE IF NO ERRORS
492.     If lngIndex > 0 Then
493.         arrDict(lngIndex).intValue = MyValue.intValue
494.         arrDict(lngIndex).strValue = MyValue.strValue
495.         arrDict(lngIndex).lngValue = MyValue.lngValue
496.     End If
497.  
498.     ' RETURN THE INDEX (OR 0 IF NOT ADDED)
499.     SaveDictionary& = lngIndex
500.  
501. End Function ' SaveDictionary&
502.  
503. ' /////////////////////////////////////////////////////////////////////////////
504.  
505. Function FindDictionaryKey& (arrDict() As DictionaryType, sKey As String)
506.     Dim lngLoop As Long
507.     Dim lngIndex As Long
508.  
509.     lngIndex = 0
510.     For lngLoop = 1 To UBound(arrDict)
511.         If LCase$(arrDict(lngLoop).Key) = LCase$(sKey) Then
512.             lngIndex = lngLoop
513.             Exit For
514.         End If
515.     Next lngLoop
516.  
517.     FindDictionaryKey& = lngIndex
518. End Function ' FindDictionaryKey&
519.  
520. ' /////////////////////////////////////////////////////////////////////////////
521.  
522. Function DeleteDictionaryKey% (arrDict() As DictionaryType, sKey As String)
523.     Dim lngIndex As Long
524.  
525.     lngIndex = FindDictionaryKey&(arrDict(), sKey)
526.  
527.     If (lngIndex > 0) Then
528.         ' clear the key
529.         arrDict(lngIndex).Key = ""
530.  
531.         ' do we have any deleted nodes?
532.         If arrDict(0).NextFree > 0 Then
533.             ' insert current node at the top of the "deleted" chain
534.             arrDict(lngIndex).NextFree = arrDict(0).NextFree
535.         End If
536.  
537.         ' soft delete
538.         arrDict(0).NextFree = lngIndex
539.  
540.         ' return true (found and deleted)
541.         DeleteDictionaryKey% = TRUE
542.     Else
543.         ' return false (not found)
544.         DeleteDictionaryKey% = FALSE
545.     End If
546.  
547. End Function ' DeleteDictionaryKey%
548.  
549. ' /////////////////////////////////////////////////////////////////////////////
550.  
551. Function DumpDictionary$ (arrDict() As DictionaryType)
552.     Dim sResult As String: sResult = ""
553.     Dim sDeleted As String: sDeleted = ","
554.     Dim iPos As Long
555.     Dim lngLoop As Long
556.  
557.     ' CREATE A LIST OF DELETED ITEMS
558.     iPos = 0
559.     While arrDict(iPos).NextFree > 0
560.         iPos = arrDict(iPos).NextFree
561.         sDeleted = sDeleted + arrDict(iPos).Key + ","
562.     Wend
563.  
564.     ' DUMP ALL ITEMS
565.     sResult = sResult + "Dictionary size: " + cstr$(UBound(arrDict) + 1) + Chr$(13)
566.     For lngLoop = 1 To UBound(arrDict)
567.         If InStr(1, sDeleted, "," + arrDict(lngLoop).Key + ",") = 0 Then
568.             sResult = sResult + "Item(" + cstrl$(lngLoop) + ")" + Chr$(13)
569.         Else
570.             sResult = sResult + "*DELETED* Item(" + cstrl$(lngLoop) + ")" + Chr$(13)
571.         End If
572.         sResult = sResult + "    .Key     =" + Chr$(34) + arrDict(lngLoop).Key + Chr$(34) + Chr$(13)
573.         sResult = sResult + "    .IntValue=" + cstr$(arrDict(lngLoop).intValue) + Chr$(13)
574.         sResult = sResult + "    .lngValue=" + cstrl$(arrDict(lngLoop).lngValue) + Chr$(13)
575.         sResult = sResult + "    .strValue=" + Chr$(34) + arrDict(lngLoop).strValue + Chr$(34) + Chr$(13)
576.         sResult = sResult + "    .NextFree=" + cstrl$(arrDict(lngLoop).NextFree) + Chr$(13)
577.         sResult = sResult + Chr$(13)
578.     Next lngLoop
579.  
580.     sResult = sResult + Chr$(13)
581.     sResult = sResult + "First deleted: " + cstrl$(arrDict(0).NextFree) + Chr$(13)
582.  
583.     ' RETURN RESULTS
584.     DumpDictionary$ = sResult
585. End Function ' DumpDictionary$
586.  
587. ' /////////////////////////////////////////////////////////////////////////////
588.  
589. Function cstr$ (myValue)
590.     cstr = LTrim$(RTrim$(Str$(myValue)))
591. End Function ' cstr$
592.  
593. ' /////////////////////////////////////////////////////////////////////////////
594. ' Convert a Long value to string and trim it (because normal Str$ adds spaces)
595.  
596. Function cstrl$ (myValue As Long)
597.     cstrl$ = _Trim$(Str$(myValue))
598. End Function ' cstrl$
599.  
600. ' /////////////////////////////////////////////////////////////////////////////
601.  
602. Function IIF (Condition, IfTrue, IfFalse)
603.     If Condition Then IIF = IfTrue Else IIF = IfFalse
604. End Function
605.  
606. ' /////////////////////////////////////////////////////////////////////////////
607.  
608. Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
609.     If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
610. End Function
611.  
612. ' /////////////////////////////////////////////////////////////////////////////
613. ' Split and join strings
614. ' https://www.qb64.org/forum/index.php?topic=1073.0
615.  
616. 'Combine all elements of in$() into a single string with delimiter$ separating the elements.
617.  
618. Function join$ (in$(), delimiter$)
619.     Dim result$
620.     Dim i As Long
621.     result$ = in$(LBound(in$))
622.     For i = LBound(in$) + 1 To UBound(in$)
623.         result$ = result$ + delimiter$ + in$(i)
624.     Next i
625.     join$ = result$
626. End Function ' join$
627.  
628. ' /////////////////////////////////////////////////////////////////////////////
629. ' Split and join strings
630. ' https://www.qb64.org/forum/index.php?topic=1073.0
631. '
632. ' FROM luke, QB64 Developer
633. ' Date: February 15, 2019, 04:11:07 AM »
634. '
635. ' Given a string of words separated by spaces (or any other character),
636. ' splits it into an array of the words. I've no doubt many people have
637. ' written a version of this over the years and no doubt there's a million
638. ' ways to do it, but I thought I'd put mine here so we have at least one
639. ' version. There's also a join function that does the opposite
640. ' array -> single string.
641. '
642. ' Code is hopefully reasonably self explanatory with comments and a little demo.
643. ' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
644.  
645. 'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
646. 'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
647. '
648. 'delimiter$ must be one character long.
649. 'result$() must have been REDIMmed previously.
650.  
651. ' Modified to handle multi-character delimiters
652.  
653. Sub split (in$, delimiter$, result$())
654.     Dim start As Integer
655.     Dim finish As Integer
656.     Dim iDelimLen As Integer
657.     ReDim result$(-1)
658.  
659.     iDelimLen = Len(delimiter$)
660.  
661.     start = 1
662.     Do
663.         'While Mid$(in$, start, 1) = delimiter$
664.         While Mid$(in$, start, iDelimLen) = delimiter$
665.             'start = start + 1
666.             start = start + iDelimLen
667.             If start > Len(in$) Then
668.                 Exit Sub
669.             End If
670.         Wend
671.         finish = InStr(start, in$, delimiter$)
672.         If finish = 0 Then
673.             finish = Len(in$) + 1
674.         End If
675.  
676.         ReDim _Preserve result$(0 To UBound(result$) + 1)
677.  
678.         result$(UBound(result$)) = Mid$(in$, start, finish - start)
679.         start = finish + 1
680.     Loop While start <= Len(in$)
681. End Sub ' split
682.  
683. ' /////////////////////////////////////////////////////////////////////////////
684.  
685. Sub SplitTest
686.     Dim in$
687.     Dim delim$
688.     ReDim arrTest$(0)
689.     Dim iLoop%
690.  
691.     delim$ = Chr$(10)
692.     in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
693.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
694.     Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)
695.     split in$, delim$, arrTest$()
696.  
697.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
698.         Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
699.     Next iLoop%
700.     Print
701.     Print "Split test finished."
702. End Sub ' SplitTest
703.  
704. ' /////////////////////////////////////////////////////////////////////////////
705.