associative arrays / dictionaries in QB64?

[bplus]

Well as you know with computer programming, you can build stuff however you like!

What will be great, will be when AI gets smart enough, that we can create our own languages without having to actually program low-level code. Just tell the AI in plain English what you want the syntax to be like, etc., and it will create a compiler for that. And eventually the tools will be smart enough to where they can translate code written in one programming language into some other language (and paradigm!) of your choice. That's coming, but I'm not holding my breath!

Oh yeah, that's here (almost) probably already in colleges and universities, math, sci and research labs, Google, IBM, Microsoft...  one of Fellippe's Episodes talked about some of that!

[TempodiBasic]

Hi MadSciJr

have you asked another way to create a dictionary ...?
Bplus has showed you the UDT  by TYPE...END TYPE and the array of UDT!
I show here a bidimensional array that manages the issue of 2 value: Key string, value number

Code: QB64: [Select]

1. ' #############################################################################
2. ' EMULATE AN ASSOCIATIVE ARRAY
3.  
4. ' BASED OFF SOME DISCUSSION AT
5. ' https://www.qb64.org/forum/index.php?topic=1001.15
6.  
7. ' Tries to emulate a simple dictionary / associative array in QB64.
8.  
9. ' Some limitations
10. ' 1. Uses a fixed array size
11. ' 2. Only stores integer values
12. ' 3. Not very efficient (simply appends new keys to the end of the array,
13. '    and searches for them in linear order)
14. ' 4. Requires declaring and passing around 2 arrays
15. '    (one for keys, one for values), instead of a single variable.
16.  
17. ' Questions
18. ' 1. Instead of a fixed size, can we implement this with variable arrays and REDIM?
19. ' 2. How can we get it to store mixed data types?
20. '    We could store the values as string, and have a third array of "type",
21. '    but would we have to manually cast each retrieved value with VAL?
22. ' 3. What are some other ways this could be better implemented?
23.  
24. ' #############################################################################
25.  
26. ' =============================================================================
27. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
28.  
29. ' boolean constants
30. CONST FALSE = 0
31. CONST TRUE = NOT FALSE
32.  
33. CONST cMax = 40
34. CONST dKey = 2, dValue = 1
35. ' =============================================================================
36. ' GLOBAL VARIABLES
37. DIM ProgramPath$
38. DIM ProgramName$
39.  
40. ' =============================================================================
41. ' INITIALIZE
42. ProgramName$ = MID$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\") + 1)
43. ProgramPath$ = LEFT$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\"))
44.  
45.  
46. ' =============================================================================
47. ' RUN TEST
48. TestDictionary
49.  
50. ' =============================================================================
51. ' FINISH
52. SYSTEM ' return control to the operating system
53. PRINT ProgramName$ + " finished."
54. END
55.  
56. ' /////////////////////////////////////////////////////////////////////////////
57.  
58. SUB TestDictionary ()
59.     REDIM arrKey(0 TO cMax, dValue TO dKey) AS STRING ' the element 0,1 is the upper limit index
60.     DIM iLoop AS INTEGER
61.     DIM bResult AS INTEGER
62.     DIM sKey AS STRING
63.     DIM iValue AS INTEGER
64.     DIM iDefault AS INTEGER
65.     DIM iIndex AS INTEGER
66.  
67.     CLS
68.  
69.     PRINT "-------------------------------------------------------------------------------"
70.     PRINT "Initializing dictionary..."
71.     InitDictionary arrKey()
72.     'PRINT "arrKey(0,dValue) = " + arrKey(0,dvalue))
73.  
74.     PRINT: PRINT DumpDictionary$(arrKey()): WaitForEnter
75.  
76.     PRINT "-------------------------------------------------------------------------------"
77.     PRINT "Writing some values..."
78.  
79.     sKey = "apple": iValue = 3:
80.     bResult = SaveDictionary%(arrKey(), sKey, iValue)
81.     PRINT "SaveDictionary%(arrKey(),  " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
82.  
83.     sKey = "africa": iValue = 1:
84.     bResult = SaveDictionary%(arrKey(), sKey, iValue)
85.     PRINT "SaveDictionary%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
86.  
87.     sKey = "zebra": iValue = 0:
88.     bResult = SaveDictionary%(arrKey(), sKey, iValue)
89.     PRINT "SaveDictionary%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
90.  
91.     sKey = "xylophone": iValue = 2:
92.     bResult = SaveDictionary%(arrKey(), sKey, iValue)
93.     PRINT "SaveDictionary%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
94.  
95.     sKey = "zebra": iValue = 4:
96.     bResult = SaveDictionary%(arrKey(), sKey, iValue)
97.     PRINT "SaveDictionary%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
98.  
99.     PRINT: PRINT DumpDictionary$(arrKey()): WaitForEnter
100.  
101.     PRINT "-------------------------------------------------------------------------------"
102.     PRINT "Deleting some keys..."
103.  
104.     sKey = "zebra": bResult = DeleteKey%(arrKey(), sKey)
105.     PRINT "DeleteKey%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
106.  
107.     sKey = "nonesuch": bResult = DeleteKey%(arrKey(), sKey)
108.     PRINT "DeleteKey%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
109.  
110.     sKey = "xylophone": bResult = DeleteKey%(arrKey(), sKey)
111.     PRINT "DeleteKey%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
112.  
113.     PRINT: PRINT DumpDictionary$(arrKey()): WaitForEnter
114.  
115.     PRINT "-------------------------------------------------------------------------------"
116.     PRINT "Look for keys..."
117.  
118.     sKey = "africa": iIndex = FoundKey%(arrKey(), sKey)
119.     PRINT "FoundKey%(arrKey(),  " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
120.  
121.     sKey = "xenophobe": iIndex = FoundKey%(arrKey(), sKey)
122.     PRINT "FoundKey%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
123.  
124.     sKey = "APPLE": iIndex = FoundKey%(arrKey(), sKey)
125.     PRINT "FoundKey%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
126.  
127.     sKey = "zambia": iIndex = FoundKey%(arrKey(), sKey)
128.     PRINT "FoundKey%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
129.  
130.     PRINT: PRINT DumpDictionary$(arrKey()): WaitForEnter
131.  
132.     PRINT "-------------------------------------------------------------------------------"
133.     PRINT "Retrieving values..."
134.  
135.     sKey = "africa": iDefault = -1000
136.     PRINT "ReadDictionary%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), sKey, iDefault))
137.  
138.     sKey = "zebra": iDefault = -3000
139.     PRINT "ReadDictionary%(arrKey(),  " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), sKey, iDefault))
140.  
141.     sKey = "apple": iDefault = -2000
142.     PRINT "ReadDictionary%(arrKey(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), sKey, iDefault))
143.  
144.     sKey = "nonesuch": iDefault = -4000
145.     PRINT "ReadDictionary%(arrKey(),  " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), sKey, iDefault))
146.  
147.     sKey = "xylophone": iDefault = -5000
148.     PRINT "ReadDictionary%(arrKey(),  " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), sKey, iDefault))
149.  
150.     PRINT: PRINT DumpDictionary$(arrKey()): WaitForEnter
151.  
152.     PRINT "-------------------------------------------------------------------------------"
153.     PRINT "This concludes the test of the pseudo-associative array / dictionary."
154.     PRINT
155.  
156.     WaitForEnter
157. END SUB ' TestDictionary
158.  
159. ' /////////////////////////////////////////////////////////////////////////////
160.  
161. SUB WaitForEnter
162.     DIM in$
163.     INPUT "Press <ENTER> to continue", in$
164. END SUB ' WaitForEnter
165.  
166. ' /////////////////////////////////////////////////////////////////////////////
167.  
168. SUB InitDictionary (Arrkey( ,) AS STRING)
169.     Arrkey(0, dValue) = _TRIM$(STR$(0))
170. END SUB ' InitDictionary
171.  
172. ' /////////////////////////////////////////////////////////////////////////////
173.  
174. FUNCTION SaveDictionary% (arrKey() AS STRING, sKey AS STRING, iValue AS INTEGER)
175.     DIM iLoop AS INTEGER
176.     iIndex = 0
177.     FOR iLoop = 1 TO VAL(arrKey(0, dValue)) ' ubound(arrKey)
178.         IF LCASE$(arrKey(iLoop, dKey)) = LCASE$(sKey) THEN
179.             iIndex = iLoop
180.             EXIT FOR
181.         END IF
182.     NEXT iLoop
183.     IF (iIndex > 0) THEN
184.         ' KEY EXISTS, UPDATE VALUE
185.         arrKey(iIndex, dValue) = _TRIM$(STR$(iValue))
186.         SaveDictionary% = TRUE
187.     ELSE
188.         ' KEY DOESN'T EXIST, ADD IT
189.  
190.         ' IS THERE ROOM?
191.         iIndex = VAL(arrKey(0, dValue)) + 1
192.         IF iIndex > UBOUND(arrKey) THEN
193.             ' DICTIONARY FULL!
194.             SaveDictionary% = FALSE
195.         ELSE
196.             ' ADD VALUE AND KEY
197.             arrKey(0, dValue) = _TRIM$(STR$(iIndex))
198.             arrKey(iIndex, dValue) = _TRIM$(STR$(iValue))
199.             arrKey(iIndex, dKey) = sKey
200.             SaveDictionary% = TRUE
201.         END IF
202.     END IF
203. END FUNCTION ' SaveDictionary%
204.  
205. ' /////////////////////////////////////////////////////////////////////////////
206.  
207. FUNCTION FoundKey% (arrKey() AS STRING, sKey AS STRING)
208.     DIM iLoop AS INTEGER
209.     DIM iIndex AS INTEGER
210.  
211.     iIndex = 0
212.     FOR iLoop = 1 TO VAL(arrKey(0, dValue)) ' ubound(arrKey)
213.         IF LCASE$(arrKey(iLoop, dKey)) = LCASE$(sKey) THEN
214.             iIndex = iLoop
215.             EXIT FOR
216.         END IF
217.     NEXT iLoop
218.  
219.     FoundKey% = iIndex
220. END FUNCTION ' FoundKey%
221.  
222. ' /////////////////////////////////////////////////////////////////////////////
223.  
224. FUNCTION DeleteKey% (arrKey() AS STRING, sKey AS STRING)
225.     DIM iLoop AS INTEGER
226.     DIM iIndex AS INTEGER
227.     DIM bResult AS INTEGER
228.  
229.     iIndex = 0
230.     FOR iLoop = 1 TO VAL(arrKey(0, dValue)) ' ubound(arrKey)
231.         IF LCASE$(arrKey(iLoop, dKey)) = LCASE$(sKey) THEN
232.             iIndex = iLoop
233.             EXIT FOR
234.         END IF
235.     NEXT iLoop
236.  
237.     IF (iIndex = 0) THEN
238.         bResult = FALSE
239.     ELSE
240.         IF iIndex < VAL(arrKey(0, dValue)) THEN
241.             FOR iLoop = iIndex TO (VAL(arrKey(0, dValue)) - 1)
242.                 arrKey(iLoop, dKey) = arrKey(iLoop + 1, dKey)
243.                 arrKey(iLoop, dValue) = arrKey(iLoop + 1, dValue)
244.             NEXT iLoop
245.         END IF
246.         arrKey(0, dValue) = _TRIM$(STR$(VAL(arrKey(0, dValue)) - 1))
247.         bResult = TRUE
248.     END IF
249.  
250.     DeleteKey% = bResult
251. END FUNCTION ' DeleteKey%
252.  
253. ' /////////////////////////////////////////////////////////////////////////////
254.  
255. FUNCTION DumpDictionary$ (arrKey() AS STRING)
256.     DIM iLoop AS INTEGER
257.     DIM sResult AS STRING
258.     sResult = ""
259.     sResult = sResult + "Dictionary size: " + arrKey(0, dValue) + CHR$(13)
260.     FOR iLoop = 1 TO VAL(arrKey(0, dValue)) ' ubound(arrKey)
261.         sResult = sResult + "Item(" + CHR$(34) + arrKey(iLoop, dKey) + CHR$(34) + ") = " + (arrKey(iLoop, dValue)) + CHR$(13)
262.     NEXT iLoop
263.     DumpDictionary$ = sResult
264. END FUNCTION ' DumpDictionary$
265.  
266. ' /////////////////////////////////////////////////////////////////////////////
267.  
268. FUNCTION ReadDictionary% (arrKey() AS STRING, sKey AS STRING, iDefault AS INTEGER)
269.     DIM iLoop AS INTEGER
270.     DIM iIndex AS INTEGER
271.  
272.     iIndex = 0
273.     FOR iLoop = 1 TO VAL(arrKey(0, dValue)) ' ubound(arrKey)
274.         IF LCASE$(arrKey(iLoop, dKey)) = LCASE$(sKey) THEN
275.             iIndex = iLoop
276.             EXIT FOR
277.         END IF
278.     NEXT iLoop
279.  
280.     IF (iIndex = 0) THEN
281.         ReadDictionary% = iDefault
282.     ELSE
283.         ReadDictionary% = VAL(arrKey(iIndex, dValue))
284.     END IF
285. END FUNCTION ' ReadDictionary%
286.  
287. ' /////////////////////////////////////////////////////////////////////////////
288.  
289. FUNCTION cstr$ (myValue)
290.     cstr = LTRIM$(RTRIM$(STR$(myValue)))
291. END FUNCTION ' cstr$
292.  
293. ' /////////////////////////////////////////////////////////////////////////////
294.  
295. FUNCTION IIF (Condition, IfTrue, IfFalse)
296.     IF Condition THEN IIF = IfTrue ELSE IIF = IfFalse
297. END FUNCTION
298.  
299. ' /////////////////////////////////////////////////////////////////////////////
300.  
301. FUNCTION IIFSTR$ (Condition, IfTrue$, IfFalse$)
302.     IF Condition THEN IIFSTR$ = IfTrue$ ELSE IIFSTR$ = IfFalse$
303. END FUNCTION
304.  
305. ' /////////////////////////////////////////////////////////////////////////////
306.  
307.  

As you can see, if you run this code, it works and the output is the same except for the iDefault values used in the Retrieving values section. I hate not so clear values so I use the thousands for iDefault (-1000,-3000 ....-4000)!

About your little database:
1. have you built it to overwrite the value if the new key is already in dictionary? Or it is a feature coming out itself?
In other words: have you decided to not have a duplicate of a Key?

2. you use a raw bubblesort to find the key into the database. Bplus have suggested to use the binary algorhytm to improve the searching section.  I want to stress that if you want a speed database you need of as many  indexes as many elements are different in the structure of database. The indexes array as integer must have 2 dimensions, one for Keys and the other for values.

3. why do you use a short main module and the work of main module has been made by a SUB (TestDictionary)? So you cut out any use of SHARED, or DIM SHARED or REDIM SHARED and you need to pass the data as parameters.

[luke]

My interpreter uses a hash table for storing program symbols. I've pulled it out and added a small demo program.

It does a proper hashing of the contents and can support any kind of data for the "value" half because it works with a UDT, but it does require two SHARED arrays and a SHARED variable. I suppose if you really wanted to you could convert it to a _MEM based thing with keep it all as local variables, but I only needed one instance of the table in my case.

Code: [Select]

DEFLNG A-Z

'Object to store in the symbol table
TYPE symtab_entry_t
    identifier AS STRING
    v1 AS LONG
    v2 AS LONG
    v3 AS LONG
END TYPE

'Actual stored obejcts
DIM SHARED symtab(1000) AS symtab_entry_t
'Mapping between hash and index
DIM SHARED symtab_map(1750) AS LONG
DIM SHARED symtab_last_entry AS LONG

'The symtab optionally supports transactions; calling symtab_rollback will
'remove all items added since the last call to symtab_commit.
DIM SHARED symtab_last_commit_id



DIM entry AS symtab_entry_t
entry.identifier = "rambunctious"
entry.v1 = 12
entry.v2 = 5
entry.v3 = 7
symtab_add_entry entry

entry.identifier = "contradict"
entry.v1 = 10
entry.v2 = 3
entry.v3 = 7
symtab_add_entry entry

entry.identifier = "explode"
entry.v1 = 7
entry.v2 = 3
entry.v3 = 4
symtab_add_entry entry

PRINT "Table has"; symtab_last_entry; "entries:"
FOR i = 1 TO symtab_last_entry
    PRINT "    "; symtab(i).identifier
NEXT i

DO
    INPUT "Select item:", lookupkey$
    result = symtab_get_id(lookupkey$)
    IF result = 0 THEN
        PRINT lookupkey$; " not in table"
    ELSE
        PRINT lookupkey$; " has"; symtab(result).v1; "letters;"; symtab(result).v2; "vowels and"; symtab(result).v3; "consonants."
    END IF
LOOP



'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'symtab.bm - Symbol Table

SUB symtab_add_entry (entry AS symtab_entry_t)
    symtab_expand_if_needed
    symtab_last_entry = symtab_last_entry + 1
    symtab(symtab_last_entry) = entry
    symtab_map_insert entry.identifier, symtab_last_entry
END SUB

FUNCTION symtab_get_id (identifier$)
    h~& = symtab_hash~&(identifier$, UBOUND(symtab_map))
    DO
        id = symtab_map(h~&)
        IF id = 0 THEN
            EXIT FUNCTION
        END IF
        IF symtab(id).identifier = identifier$ THEN
            symtab_get_id = id
            EXIT FUNCTION
        END IF
        h~& = (h~& + 1) MOD (UBOUND(symtab_map) + 1)
    LOOP
END FUNCTION

'I'd like to be able to use this code for recoverable errors when in interactive
'mode (rollback if an invalid line was entered), but it's not clear how one does
'recoverable error handling in the parser since we don't have proper exceptions.
SUB symtab_commit
    symtab_last_commit_id = symtab_last_entry
END SUB

SUB symtab_rollback
    'Would it be more efficient to do this in reverse order?
    'Does anyone care about how fast it is?
    FOR i = symtab_last_commit_id + 1 TO symtab_last_entry
        identifier$ = symtab(i).identifier
        h~& = symtab_hash~&(identifier$, UBOUND(symtab_map))
        DO
            id = symtab_map(h~&)
            IF symtab(id).identifier = identifier$ THEN EXIT DO
            h~& = (h~& + 1) MOD (UBOUND(symtab_map) + 1)
        LOOP
        symtab_map(h~&) = 0
    NEXT i
    symtab_last_entry = symtab_last_commit_id
END SUB

'Strictly internal functions below
SUB symtab_expand_if_needed
    CONST SYMTAB_MAX_LOADING = 0.75
    CONST SYMTAB_GROWTH_FACTOR = 2
    IF symtab_last_entry = UBOUND(symtab) THEN
        REDIM _PRESERVE symtab(UBOUND(symtab) * SYMTAB_GROWTH_FACTOR) AS symtab_entry_t
    END IF

    IF symtab_last_entry / UBOUND(symtab_map) <= SYMTAB_MAX_LOADING THEN EXIT FUNCTION
    REDIM symtab_map(UBOUND(symtab_map) * SYMTAB_GROWTH_FACTOR)
    FOR i = 1 TO symtab_last_entry
        symtab_map_insert symtab(i).identifier, i
    NEXT i
END SUB

SUB symtab_map_insert (k$, v)
    h~& = symtab_hash~&(k$, UBOUND(symtab_map))
    DO
        IF symtab_map(h~&) = 0 THEN EXIT DO
        h~& = (h~& + 1) MOD (UBOUND(symtab_map) + 1)
    LOOP
    symtab_map(h~&) = v
END SUB

'http://www.cse.yorku.ca/~oz/hash.html
'Attributed to D. J. Bernstein
FUNCTION symtab_hash~& (k$, max)
    hash~& = 5381
    FOR i = 1 TO LEN(k$)
        hash~& = ((hash~& * 33) XOR ASC(k$, i)) MOD max
    NEXT i
    '0<=hash<=max-1, so 1<=hash+1<=max
    symtab_hash~& = hash~& + 1
END FUNCTION