Author Topic: associative arrays / dictionaries in QB64?  (Read 4973 times)

0 Members and 1 Guest are viewing this topic.

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
associative arrays / dictionaries in QB64?
« on: December 18, 2020, 06:24:46 pm »
Hey everyone... Happy Friday.
I have another newb question, I'm not finding anything on associative arrays -
does QB64 support associative arrays out of the box,
is there a library or an include file that everyone uses,
or is it just "roll your own"?

For fun I made a crude implementation (see code below).
For my purposes I don't need anything heavy duty,
but if there is a better way I would appreciate knowing...

Thanks
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.  
  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. ' RUN TEST
  47. TestDictionary
  48.  
  49. ' =============================================================================
  50. ' FINISH
  51. SYSTEM ' return control to the operating system
  52. PRINT ProgramName$ + " finished."
  53.  
  54. ' /////////////////////////////////////////////////////////////////////////////
  55.  
  56. SUB TestDictionary ()
  57.     DIM arrKey(40) AS STRING
  58.     DIM arrValue(40) AS INTEGER
  59.     DIM iLoop AS INTEGER
  60.     DIM bResult AS INTEGER
  61.     DIM sKey AS STRING
  62.     DIM iValue AS INTEGER
  63.     DIM iDefault AS INTEGER
  64.     DIM iIndex AS INTEGER
  65.  
  66.     CLS
  67.  
  68.     PRINT "-------------------------------------------------------------------------------"
  69.     PRINT "Initializing dictionary..."
  70.     InitDictionary arrValue()
  71.     'PRINT "arrValue(0) = " + cstr$(arrValue(0))
  72.  
  73.     PRINT: PRINT DumpDictionary$(arrKey(), arrValue()): WaitForEnter
  74.  
  75.     PRINT "-------------------------------------------------------------------------------"
  76.     PRINT "Writing some values..."
  77.  
  78.     sKey = "apple": iValue = 3:
  79.     bResult = SaveDictionary%(arrKey(), arrValue(), sKey, iValue)
  80.     PRINT "SaveDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  81.  
  82.     sKey = "africa": iValue = 1:
  83.     bResult = SaveDictionary%(arrKey(), arrValue(), sKey, iValue)
  84.     PRINT "SaveDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  85.  
  86.     sKey = "zebra": iValue = 0:
  87.     bResult = SaveDictionary%(arrKey(), arrValue(), sKey, iValue)
  88.     PRINT "SaveDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  89.  
  90.     sKey = "xylophone": iValue = 2:
  91.     bResult = SaveDictionary%(arrKey(), arrValue(), sKey, iValue)
  92.     PRINT "SaveDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  93.  
  94.     sKey = "zebra": iValue = 4:
  95.     bResult = SaveDictionary%(arrKey(), arrValue(), sKey, iValue)
  96.     PRINT "SaveDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  97.  
  98.     PRINT: PRINT DumpDictionary$(arrKey(), arrValue()): WaitForEnter
  99.  
  100.     PRINT "-------------------------------------------------------------------------------"
  101.     PRINT "Deleting some keys..."
  102.  
  103.     sKey = "zebra": bResult = DeleteKey%(arrKey(), arrValue(), sKey)
  104.     PRINT "DeleteKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  105.  
  106.     sKey = "nonesuch": bResult = DeleteKey%(arrKey(), arrValue(), sKey)
  107.     PRINT "DeleteKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  108.  
  109.     sKey = "xylophone": bResult = DeleteKey%(arrKey(), arrValue(), sKey)
  110.     PRINT "DeleteKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  111.  
  112.     PRINT: PRINT DumpDictionary$(arrKey(), arrValue()): WaitForEnter
  113.  
  114.     PRINT "-------------------------------------------------------------------------------"
  115.     PRINT "Look for keys..."
  116.  
  117.     sKey = "africa": iIndex = FoundKey%(arrKey(), arrValue(), sKey)
  118.     PRINT "FoundKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  119.  
  120.     sKey = "xenophobe": iIndex = FoundKey%(arrKey(), arrValue(), sKey)
  121.     PRINT "FoundKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  122.  
  123.     sKey = "APPLE": iIndex = FoundKey%(arrKey(), arrValue(), sKey)
  124.     PRINT "FoundKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  125.  
  126.     sKey = "zambia": iIndex = FoundKey%(arrKey(), arrValue(), sKey)
  127.     PRINT "FoundKey%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  128.  
  129.     PRINT: PRINT DumpDictionary$(arrKey(), arrValue()): WaitForEnter
  130.  
  131.     PRINT "-------------------------------------------------------------------------------"
  132.     PRINT "Retrieving values..."
  133.  
  134.     sKey = "africa": iDefault = -1
  135.     PRINT "ReadDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), arrValue(), sKey, iDefault))
  136.  
  137.     sKey = "zebra": iDefault = -3
  138.     PRINT "ReadDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), arrValue(), sKey, iDefault))
  139.  
  140.     sKey = "apple": iDefault = -2
  141.     PRINT "ReadDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), arrValue(), sKey, iDefault))
  142.  
  143.     sKey = "nonesuch": iDefault = -4
  144.     PRINT "ReadDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), arrValue(), sKey, iDefault))
  145.  
  146.     sKey = "xylophone": iDefault = -5
  147.     PRINT "ReadDictionary%(arrKey(), arrValue(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadDictionary%(arrKey(), arrValue(), sKey, iDefault))
  148.  
  149.     PRINT: PRINT DumpDictionary$(arrKey(), arrValue()): WaitForEnter
  150.  
  151.     PRINT "-------------------------------------------------------------------------------"
  152.     PRINT "This concludes the test of the pseudo-associative array / dictionary."
  153.     PRINT
  154.  
  155.     WaitForEnter
  156. END SUB ' TestDictionary
  157.  
  158. ' /////////////////////////////////////////////////////////////////////////////
  159.  
  160. SUB WaitForEnter
  161.     DIM in$
  162.     INPUT "Press <ENTER> to continue", in$
  163. END SUB ' WaitForEnter
  164.  
  165. ' /////////////////////////////////////////////////////////////////////////////
  166.  
  167. SUB InitDictionary (arrValue( 40) AS INTEGER)
  168.     arrValue(0) = 0
  169. END SUB ' InitDictionary
  170.  
  171. ' /////////////////////////////////////////////////////////////////////////////
  172.  
  173. FUNCTION SaveDictionary% (arrKey( 40) AS STRING, arrValue( 40) AS INTEGER, sKey AS STRING, iValue AS INTEGER)
  174.     DIM iLoop AS INTEGER
  175.     iIndex = 0
  176.     FOR iLoop = 1 TO arrValue(0) ' ubound(arrKey)
  177.         IF LCASE$(arrKey(iLoop)) = LCASE$(sKey) THEN
  178.             iIndex = iLoop
  179.             EXIT FOR
  180.         END IF
  181.     NEXT iLoop
  182.     IF (iIndex > 0) THEN
  183.         ' KEY EXISTS, UPDATE VALUE
  184.         arrValue(iIndex) = iValue
  185.         SaveDictionary% = TRUE
  186.     ELSE
  187.         ' KEY DOESN'T EXIST, ADD IT
  188.  
  189.         ' IS THERE ROOM?
  190.         iIndex = arrValue(0) + 1
  191.         IF iIndex > UBOUND(arrKey) THEN
  192.             ' DICTIONARY FULL!
  193.             SaveDictionary% = FALSE
  194.         ELSE
  195.             ' ADD VALUE AND KEY
  196.             arrValue(0) = iIndex
  197.             arrValue(iIndex) = iValue
  198.             arrKey(iIndex) = sKey
  199.             SaveDictionary% = TRUE
  200.         END IF
  201.     END IF
  202. END FUNCTION ' SaveDictionary%
  203.  
  204. ' /////////////////////////////////////////////////////////////////////////////
  205.  
  206. FUNCTION FoundKey% (arrKey( 40) AS STRING, arrValue( 40) AS INTEGER, sKey AS STRING)
  207.     DIM iLoop AS INTEGER
  208.     DIM iIndex AS INTEGER
  209.  
  210.     iIndex = 0
  211.     FOR iLoop = 1 TO arrValue(0) ' ubound(arrKey)
  212.         IF LCASE$(arrKey(iLoop)) = LCASE$(sKey) THEN
  213.             iIndex = iLoop
  214.             EXIT FOR
  215.         END IF
  216.     NEXT iLoop
  217.  
  218.     FoundKey% = iIndex
  219. END FUNCTION ' FoundKey%
  220.  
  221. ' /////////////////////////////////////////////////////////////////////////////
  222.  
  223. FUNCTION DeleteKey% (arrKey( 40) AS STRING, arrValue( 40) AS INTEGER, sKey AS STRING)
  224.     DIM iLoop AS INTEGER
  225.     DIM iIndex AS INTEGER
  226.     DIM bResult AS INTEGER
  227.  
  228.     iIndex = 0
  229.     FOR iLoop = 1 TO arrValue(0) ' ubound(arrKey)
  230.         IF LCASE$(arrKey(iLoop)) = LCASE$(sKey) THEN
  231.             iIndex = iLoop
  232.             EXIT FOR
  233.         END IF
  234.     NEXT iLoop
  235.  
  236.     IF (iIndex = 0) THEN
  237.         bResult = FALSE
  238.     ELSE
  239.         IF iIndex < arrValue(0) THEN
  240.             FOR iLoop = iIndex TO (arrValue(0) - 1)
  241.                 arrKey(iLoop) = arrKey(iLoop + 1)
  242.                 arrValue(iLoop) = arrValue(iLoop + 1)
  243.             NEXT iLoop
  244.         END IF
  245.         arrValue(0) = arrValue(0) - 1
  246.         bResult = TRUE
  247.     END IF
  248.  
  249.     DeleteKey% = bResult
  250. END FUNCTION ' DeleteKey%
  251.  
  252. ' /////////////////////////////////////////////////////////////////////////////
  253.  
  254. FUNCTION DumpDictionary$ (arrKey( 40) AS STRING, arrValue( 40) AS INTEGER)
  255.     DIM iLoop AS INTEGER
  256.     DIM sResult AS STRING
  257.     sResult = ""
  258.     sResult = sResult + "Dictionary size: " + cstr$(arrValue(0)) + CHR$(13)
  259.     FOR iLoop = 1 TO arrValue(0) ' ubound(arrKey)
  260.         sResult = sResult + "Item(" + CHR$(34) + arrKey(iLoop) + CHR$(34) + ") = " + cstr$(arrValue(iLoop)) + CHR$(13)
  261.     NEXT iLoop
  262.     DumpDictionary$ = sResult
  263. END FUNCTION ' DumpDictionary$
  264.  
  265. ' /////////////////////////////////////////////////////////////////////////////
  266.  
  267. FUNCTION ReadDictionary% (arrKey( 40) AS STRING, arrValue( 40) AS INTEGER, sKey AS STRING, iDefault AS INTEGER)
  268.     DIM iLoop AS INTEGER
  269.     DIM iIndex AS INTEGER
  270.  
  271.     iIndex = 0
  272.     FOR iLoop = 1 TO arrValue(0) ' ubound(arrKey)
  273.         IF LCASE$(arrKey(iLoop)) = LCASE$(sKey) THEN
  274.             iIndex = iLoop
  275.             EXIT FOR
  276.         END IF
  277.     NEXT iLoop
  278.  
  279.     IF (iIndex = 0) THEN
  280.         ReadDictionary% = iDefault
  281.     ELSE
  282.         ReadDictionary% = arrValue(iIndex)
  283.     END IF
  284. END FUNCTION ' ReadDictionary%
  285.  
  286. ' /////////////////////////////////////////////////////////////////////////////
  287.  
  288. FUNCTION cstr$ (myValue)
  289.     cstr = LTRIM$(RTRIM$(STR$(myValue)))
  290. END FUNCTION ' cstr$
  291.  
  292. ' /////////////////////////////////////////////////////////////////////////////
  293.  
  294. FUNCTION IIF (Condition, IfTrue, IfFalse)
  295.     IF Condition THEN IIF = IfTrue ELSE IIF = IfFalse
  296.  
  297. ' /////////////////////////////////////////////////////////////////////////////
  298.  
  299. FUNCTION IIFSTR$ (Condition, IfTrue$, IfFalse$)
  300.     IF Condition THEN IIFSTR$ = IfTrue$ ELSE IIFSTR$ = IfFalse$
  301.  
  302. ' /////////////////////////////////////////////////////////////////////////////
  303.  
« Last Edit: December 18, 2020, 06:37:00 pm by madscijr »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #1 on: December 18, 2020, 07:00:45 pm »
I dont know what app you have in mind but generally I would think User Defined TYPE does a fine job of grouping things associated to each other.

Type Dictionary
   Key as string
   Value as Integer
   (... or a whole slew of things with key)
end Type
« Last Edit: December 18, 2020, 07:01:51 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #2 on: December 18, 2020, 07:09:07 pm »
Oh ha! I do this:
Code: QB64: [Select]
  1. FUNCTION cstr$ (myValue)
  2.     cstr = LTRIM$(RTRIM$(STR$(myValue)))
  3.  

like this:
Code: QB64: [Select]
« Last Edit: December 18, 2020, 07:10:21 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #3 on: December 18, 2020, 07:21:37 pm »
Want to take a shot at sorting a Dictionary by Key or by Value? ;)

Then we could do Binary searches.

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #4 on: December 19, 2020, 12:42:26 pm »
I would think User Defined TYPE does a fine job of grouping things associated to each other.
Type Dictionary
   Key as string
   Value as Integer
   (... or a whole slew of things with key)
end Type

Oh duh, yes. I got a little "dyslexic" about the rule about no arrays in UDTs.
But you can have arrays _of_ UDTs!

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

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #5 on: December 19, 2020, 12:46:09 pm »
Oh ha! I do this:
...
Code: QB64: [Select]
Oh duh, there is a _TRIM$ function after all! Thanks.

Followup question on that, I don't see anything about QB64 supporting "variant" types.
Does that parameter accept values other than just integer?

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #6 on: December 19, 2020, 12:50:03 pm »
Want to take a shot at sorting a Dictionary by Key or by Value? ;)
Then we could do Binary searches.

I have various VBA and VB6 sorting routines laying around, not sure how much of that stuff needs to be reworked for QB64.

One thing I am kind of fuzzy on, and have avoided so far in QB64 due to laziness & not wanting to get caught up right now in details, is dynamic array stuff. I was getting these frustrating errors with using REDIM, so I just avoided dynamic arrays. That probably won't be necessary for sorting, but it might make the dictionary implementation better. Also, if we want to create a copy of an array, how would we DIM it dynamically to match the size of the original array? I haven't really dove into any of that yet...
Thanks

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #7 on: December 19, 2020, 01:40:28 pm »
Quote
But you can have arrays _of_ UDTs!

Yes, that's the best part! Only one caveat, you can't file them if they have variable length strings. Oh, another, Functions can not return UDT's.


Quote
Followup question on that ((FUNCTION) TS$ = _TRIM$(STR$(AnInteger)), I don't see anything about QB64 supporting "variant" types.
Does that parameter accept values other than just integer?

No variant type, not in QB64 which gets all our code translated to C+ and then compiled, so pretty formal with variable types.
SmallBASIC (not MS version: Small Basic) is really cool with variant type, you don't even have to pre-define your UDT's! but it is Interpreter only and has miserable IDE (from Right mouse popup menu) nice on Android though.

PS yeah be careful with undeclared types in Function definitions, make sure it is what you are using for default Type.
New ideas LONG Type works as fast or faster than INTEGER Type as Dynamic arrays are just as fast as STATIC so unless there is some really special case use Default Single or DEFLNG A-Z for all LONGs as default variable Type and REDIM for arrays because Dynamic are more powerful because they can be changed in size without losing data.

Quote
I was getting these frustrating errors with using REDIM, so I just avoided dynamic arrays.
Yeah so if you are having problems with Dynamic arrays, let's get them straighten out to save time and grief in future and get you up to date with QB64.

I think the main key here is always start an array as REDIM not DIM! Even though there is nothing to RE do, that's the only way to start a Dynamic array. Once it's Dynamic you can erase (without ERASE that you need for DIM MyStaticArray(nItems) with another REDIM myDynamicArray(nItems) or save data and change size REDIM _PRESERVE myDynamicArray(nItems + nNewItems).


BTW copying an array is a weakness for QB64 ( You cant just say B$() = A$() ) but I have routine using _Mem that works for arrays that aren't strings and there is another way for arrays with strings ie check with SMcNeill the _MEM master :) Funny I haven't needed that so much.
And for sorting, I have a QuickSort routine I modify for what ever type the array is and what the sort key type is.
« Last Edit: December 19, 2020, 02:18:42 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #8 on: December 19, 2020, 02:27:55 pm »
Oh I just got around to testing Dictionary Tools

This is interesting,
  [ You are not allowed to view this attachment ]  

You aren't just returning 0 if not found, plus you have to input a "search" place along with search item?

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #9 on: December 20, 2020, 11:32:16 am »
Oh I just got around to testing Dictionary Tools
This is interesting,
  [ You are not allowed to view this attachment ]  
You aren't just returning 0 if not found, plus you have to input a "search" place along with search item?

No, the second parameter lets you specify a default value to return if the key is not found, that's all.
For my purposes, that usually saves some coding.

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #10 on: December 20, 2020, 12:06:38 pm »
Yeah so if you are having problems with Dynamic arrays, let's get them straighten out to save time and grief in future and get you up to date with QB64.

I think the main key here is always start an array as REDIM not DIM! Even though there is nothing to RE do, that's the only way to start a Dynamic array. Once it's Dynamic you can erase (without ERASE that you need for DIM MyStaticArray(nItems) with another REDIM myDynamicArray(nItems) or save data and change size REDIM _PRESERVE myDynamicArray(nItems + nNewItems).

Thanks for explaining. I recoded it to use dynamic arrays, and now it's much cleaner! (Updated code below.)

BTW copying an array is a weakness for QB64 ( You cant just say B$() = A$() ) but I have routine using _Mem that works for arrays that aren't strings and there is another way for arrays with strings ie check with SMcNeill the _MEM master :) Funny I haven't needed that so much.
And for sorting, I have a QuickSort routine I modify for what ever type the array is and what the sort key type is.

I saw some mention of the _MEM or mem copy functions -
how "brittle" is code that relies on it? Will it work across platforms (on Mac or Linux)?
If you can post an example function to copy an array of these
Code: QB64: [Select]
  1. Type IntDictionary
  2.    Value as Integer
  3.  
and an array of these
Code: QB64: [Select]
  1. Type StrDictionary
  2.    Value AS STRING
  3.  
then I can try to add a "copy" function.
(Though for my purposes, just iterating through it, and doing a straight copy should be fast enough. I am more just curious.)

Anyway here is the updated dictionary code with dynamic arrays:
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. FIXED THANKS TO BPLUS! Uses a fixed array size
  11. ' 2. Only stores integer values. To store other types, just make a copy
  12. '    and modify the types and function names. Currently the
  13. '    naming convention is pretty clunky, but it is unambiguous!
  14. ' 3. Not very efficient (simply appends new keys to the end of the array,
  15. '    and searches for them in linear order)
  16. ' 4. FIXED THANKS TO BPLUS! Requires declaring and passing around 2 arrays
  17. '    (one for keys, one for values), instead of a single variable.
  18. '    Now we just pass one array of user-defined type with key/value.
  19. ' 5. No sorting.
  20. '
  21. ' Questions
  22. ' 1. YES THANKS BPLUS! Instead of a fixed size, can we implement this with
  23. '    variable arrays and REDIM?
  24. ' 2. How can we get it to store mixed data types?
  25. '    We could store the values as string, and have a third array of "type",
  26. '    but would we have to manually cast each retrieved value with VAL?
  27. '    A lazy way of doing it could be add values to the Dictionary UDT
  28. '    to hold each type, so we have:
  29. '        Type Dictionary
  30. '            Key AS STRING
  31. '            Type AS STRING ' specifies type ("$", "%", "&", "!", or "#")
  32. '                           ' (or make this type int and use constants)
  33. '            strValue AS STRING
  34. '            intValue AS INTEGER
  35. '            lngValue AS LONG
  36. '            sngValue AS SINGLE
  37. '            dblValue AS DOUBLE
  38. '            etc.
  39. '        End Type
  40. '    and have functions like ReadDictionaryString, WriteDictionaryString,
  41. '    ReadDictionaryInt, WriteDictionaryInt, etc. Theoretically one key could
  42. '    point to multiple values. Just add what you want. Kind of wasteful,
  43. '    and a very lazy way to implement it, but simple multipurpose design?
  44. '    We could implement an in-memory database, or structures like STxAxTIC
  45. '    discusses here: https://www.qb64.org/forum/index.php?topic=2447.0
  46. '    The sky is the limit! So many possibilities, but I just needed a simple
  47. '    way to do an associative array / dictionary for a relatively small number
  48. '    of keys, so for now I think it's easier to just make separate
  49. '    dictionary functions/types for each variable type you want to store.
  50. ' 3. Would it be more efficient if we inserted elements in sort order,
  51. '    so the dictionary is always sorted? That would speed up read (which would
  52. '    find the key with a binary search) but slow down write.
  53. ' 4. If we added a sort function, to sort by value OR key?
  54. '    Which algorithm would be fast (but not too complex to debug &
  55. '    understand) for integer values? For string values?
  56. ' 5. What are some other ways this could be better implemented?
  57.  
  58. ' #############################################################################
  59.  
  60. ' =============================================================================
  61. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
  62.  
  63. ' boolean constants
  64. CONST FALSE = 0
  65. CONST TRUE = NOT FALSE
  66.  
  67. CONST cIntDictMax = 255 ' lets us limit the size of the dictionary
  68.  
  69. ' =============================================================================
  70. ' UDTs
  71.  
  72. TYPE IntDictionary
  73.     Key AS STRING
  74.     Value AS INTEGER
  75.  
  76. ' =============================================================================
  77. ' GLOBAL VARIABLES
  78. DIM ProgramPath$
  79. DIM ProgramName$
  80.  
  81. ' =============================================================================
  82. ' INITIALIZE
  83. ProgramName$ = MID$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\") + 1)
  84. ProgramPath$ = LEFT$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\"))
  85.  
  86. ' =============================================================================
  87. ' RUN TEST
  88. TestIntDictionary
  89.  
  90. ' =============================================================================
  91. ' FINISH
  92. SYSTEM ' return control to the operating system
  93. PRINT ProgramName$ + " finished."
  94.  
  95. ' /////////////////////////////////////////////////////////////////////////////
  96.  
  97. SUB TestIntDictionary ()
  98.     REDIM arrDict(-1) AS IntDictionary
  99.     DIM iLoop AS INTEGER
  100.     DIM bResult AS INTEGER
  101.     DIM sKey AS STRING
  102.     DIM iValue AS INTEGER
  103.     DIM iDefault AS INTEGER
  104.     DIM iIndex AS INTEGER
  105.  
  106.     CLS
  107.  
  108.     PRINT "-------------------------------------------------------------------------------"
  109.     PRINT "Initializing integer-value dictionary..."
  110.     InitIntDictionary arrDict()
  111.     'PRINT "arrDict(0).Value = " + cstr$(arrDict(0).Value)
  112.  
  113.     PRINT: PRINT DumpIntDictionary$(arrDict()): WaitForEnter
  114.  
  115.     PRINT "-------------------------------------------------------------------------------"
  116.     PRINT "Writing some values..."
  117.  
  118.     sKey = "apple": iValue = 3:
  119.     bResult = SaveIntDictionary%(arrDict(), sKey, iValue)
  120.     PRINT "SaveIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  121.  
  122.     sKey = "africa": iValue = 1:
  123.     bResult = SaveIntDictionary%(arrDict(), sKey, iValue)
  124.     PRINT "SaveIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  125.  
  126.     sKey = "zebra": iValue = 0:
  127.     bResult = SaveIntDictionary%(arrDict(), sKey, iValue)
  128.     PRINT "SaveIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  129.  
  130.     sKey = "xylophone": iValue = 2:
  131.     bResult = SaveIntDictionary%(arrDict(), sKey, iValue)
  132.     PRINT "SaveIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  133.  
  134.     sKey = "zebra": iValue = 4:
  135.     bResult = SaveIntDictionary%(arrDict(), sKey, iValue)
  136.     PRINT "SaveIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iValue) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  137.  
  138.     PRINT: PRINT DumpIntDictionary$(arrDict()): WaitForEnter
  139.  
  140.     PRINT "-------------------------------------------------------------------------------"
  141.     PRINT "Deleting some keys..."
  142.  
  143.     sKey = "zebra": bResult = DeleteIntDictionaryKey%(arrDict(), sKey)
  144.     PRINT "DeleteIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  145.  
  146.     sKey = "nonesuch": bResult = DeleteIntDictionaryKey%(arrDict(), sKey)
  147.     PRINT "DeleteIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  148.  
  149.     sKey = "xylophone": bResult = DeleteIntDictionaryKey%(arrDict(), sKey)
  150.     PRINT "DeleteIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + IIFSTR$(bResult, "TRUE", "FALSE")
  151.  
  152.     PRINT: PRINT DumpIntDictionary$(arrDict()): WaitForEnter
  153.  
  154.     PRINT "-------------------------------------------------------------------------------"
  155.     PRINT "Look for keys..."
  156.  
  157.     sKey = "africa": iIndex = FoundIntDictionaryKey%(arrDict(), sKey)
  158.     PRINT "FoundIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  159.  
  160.     sKey = "xenophobe": iIndex = FoundIntDictionaryKey%(arrDict(), sKey)
  161.     PRINT "FoundIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  162.  
  163.     sKey = "APPLE": iIndex = FoundIntDictionaryKey%(arrDict(), sKey)
  164.     PRINT "FoundIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  165.  
  166.     sKey = "zambia": iIndex = FoundIntDictionaryKey%(arrDict(), sKey)
  167.     PRINT "FoundIntDictionaryKey%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ") returns " + cstr$(iIndex) + " which evaluates to " + IIFSTR$(iIndex, "TRUE", "FALSE")
  168.  
  169.     PRINT: PRINT DumpIntDictionary$(arrDict()): WaitForEnter
  170.  
  171.     PRINT "-------------------------------------------------------------------------------"
  172.     PRINT "Retrieving values..."
  173.  
  174.     sKey = "africa": iDefault = -1
  175.     PRINT "ReadIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadIntDictionary%(arrDict(), sKey, iDefault))
  176.  
  177.     sKey = "zebra": iDefault = -3
  178.     PRINT "ReadIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadIntDictionary%(arrDict(), sKey, iDefault))
  179.  
  180.     sKey = "apple": iDefault = -2
  181.     PRINT "ReadIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadIntDictionary%(arrDict(), sKey, iDefault))
  182.  
  183.     sKey = "nonesuch": iDefault = -4
  184.     PRINT "ReadIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadIntDictionary%(arrDict(), sKey, iDefault))
  185.  
  186.     sKey = "xylophone": iDefault = -5
  187.     PRINT "ReadIntDictionary%(arrDict(), " + CHR$(34) + sKey + CHR$(34) + ", " + cstr$(iDefault) + ") returns: " + cstr$(ReadIntDictionary%(arrDict(), sKey, iDefault))
  188.  
  189.     PRINT: PRINT DumpIntDictionary$(arrDict()): WaitForEnter
  190.  
  191.     PRINT "-------------------------------------------------------------------------------"
  192.     PRINT "This concludes the test of the pseudo-associative array / integer dictionary."
  193.     PRINT
  194.  
  195.     WaitForEnter
  196. END SUB ' TestIntDictionary
  197.  
  198. ' /////////////////////////////////////////////////////////////////////////////
  199.  
  200. SUB WaitForEnter
  201.     DIM in$
  202.     INPUT "Press <ENTER> to continue", in$
  203. END SUB ' WaitForEnter
  204.  
  205. ' /////////////////////////////////////////////////////////////////////////////
  206.  
  207. SUB InitIntDictionary (arrDict() AS IntDictionary)
  208.     REDIM arrDict(-1) AS IntDictionary
  209.     'arrDict(0).Value = 0
  210. END SUB ' InitIntDictionary
  211.  
  212. ' /////////////////////////////////////////////////////////////////////////////
  213.  
  214. FUNCTION SaveIntDictionary% (arrDict() AS IntDictionary, sKey AS STRING, iValue AS INTEGER)
  215.     DIM iLoop AS INTEGER
  216.     DIM iIndex AS INTEGER
  217.     iIndex = -1
  218.     FOR iLoop = 0 TO UBOUND(arrDict)
  219.         IF LCASE$(arrDict(iLoop).Key) = LCASE$(sKey) THEN
  220.             iIndex = iLoop
  221.             EXIT FOR
  222.         END IF
  223.     NEXT iLoop
  224.     IF (iIndex > -1) THEN
  225.         ' KEY EXISTS, UPDATE VALUE
  226.         arrDict(iIndex).Value = iValue
  227.         SaveIntDictionary% = TRUE
  228.     ELSE
  229.         ' KEY DOESN'T EXIST, ADD IT
  230.  
  231.         ' IS THERE ROOM?
  232.         iIndex = UBOUND(arrDict) + 1
  233.         IF iIndex > cIntDictMax THEN
  234.             ' DICTIONARY FULL!
  235.             SaveIntDictionary% = FALSE
  236.         ELSE
  237.             ' ADD VALUE AND KEY
  238.             REDIM _PRESERVE arrDict(iIndex) AS IntDictionary
  239.             arrDict(iIndex).Value = iValue
  240.             arrDict(iIndex).Key = sKey
  241.             SaveIntDictionary% = TRUE
  242.         END IF
  243.     END IF
  244. END FUNCTION ' SaveIntDictionary%
  245.  
  246. ' /////////////////////////////////////////////////////////////////////////////
  247.  
  248. FUNCTION FoundIntDictionaryKey% (arrDict() AS IntDictionary, sKey AS STRING)
  249.     DIM iLoop AS INTEGER
  250.     DIM iIndex AS INTEGER
  251.  
  252.     iIndex = -1
  253.     FOR iLoop = 0 TO UBOUND(arrDict)
  254.         IF LCASE$(arrDict(iLoop).Key) = LCASE$(sKey) THEN
  255.             iIndex = iLoop
  256.             EXIT FOR
  257.         END IF
  258.     NEXT iLoop
  259.  
  260.     FoundIntDictionaryKey% = iIndex
  261. END FUNCTION ' FoundIntDictionaryKey%
  262.  
  263. ' /////////////////////////////////////////////////////////////////////////////
  264.  
  265. FUNCTION DeleteIntDictionaryKey% (arrDict() AS IntDictionary, sKey AS STRING)
  266.     DIM iLoop AS INTEGER
  267.     DIM iIndex AS INTEGER
  268.     DIM bResult AS INTEGER
  269.  
  270.     iIndex = -1
  271.     FOR iLoop = 0 TO UBOUND(arrDict)
  272.         IF LCASE$(arrDict(iLoop).Key) = LCASE$(sKey) THEN
  273.             iIndex = iLoop
  274.             EXIT FOR
  275.         END IF
  276.     NEXT iLoop
  277.  
  278.     IF (iIndex > -1) THEN
  279.         IF iIndex < UBOUND(arrDict) THEN
  280.             FOR iLoop = (UBOUND(arrDict) - 1) TO iIndex STEP -1
  281.                 arrDict(iLoop).Key = arrDict(iLoop + 1).Key
  282.                 arrDict(iLoop).Value = arrDict(iLoop + 1).Value
  283.             NEXT iLoop
  284.         END IF
  285.         REDIM _PRESERVE arrDict(UBOUND(arrDict) - 1) AS IntDictionary
  286.         bResult = TRUE
  287.     ELSE
  288.         bResult = FALSE
  289.     END IF
  290.  
  291.     DeleteIntDictionaryKey% = bResult
  292. END FUNCTION ' DeleteIntDictionaryKey%
  293.  
  294. ' /////////////////////////////////////////////////////////////////////////////
  295.  
  296. FUNCTION DumpIntDictionary$ (arrDict() AS IntDictionary)
  297.     DIM iLoop AS INTEGER
  298.     DIM sResult AS STRING
  299.     sResult = ""
  300.     sResult = sResult + "IntDictionary size: " + cstr$(UBOUND(arrDict) + 1) + CHR$(13)
  301.     FOR iLoop = 0 TO UBOUND(arrDict)
  302.         sResult = sResult + "Item(" + CHR$(34) + arrDict(iLoop).Key + CHR$(34) + ") = " + cstr$(arrDict(iLoop).Value) + CHR$(13)
  303.     NEXT iLoop
  304.     DumpIntDictionary$ = sResult
  305. END FUNCTION ' DumpIntDictionary$
  306.  
  307. ' /////////////////////////////////////////////////////////////////////////////
  308.  
  309. FUNCTION ReadIntDictionary% (arrDict() AS IntDictionary, sKey AS STRING, iDefault AS INTEGER)
  310.     DIM iLoop AS INTEGER
  311.     DIM iIndex AS INTEGER
  312.  
  313.     iIndex = -1
  314.     FOR iLoop = 0 TO UBOUND(arrDict)
  315.         IF LCASE$(arrDict(iLoop).Key) = LCASE$(sKey) THEN
  316.             iIndex = iLoop
  317.             EXIT FOR
  318.         END IF
  319.     NEXT iLoop
  320.  
  321.     IF (iIndex > -1) THEN
  322.         ReadIntDictionary% = arrDict(iIndex).Value
  323.     ELSE
  324.         ReadIntDictionary% = iDefault
  325.     END IF
  326. END FUNCTION ' ReadIntDictionary%
  327.  
  328. ' /////////////////////////////////////////////////////////////////////////////
  329.  
  330. FUNCTION cstr$ (myValue)
  331.     cstr = LTRIM$(RTRIM$(STR$(myValue)))
  332. END FUNCTION ' cstr$
  333.  
  334. ' /////////////////////////////////////////////////////////////////////////////
  335.  
  336. FUNCTION IIF (Condition, IfTrue, IfFalse)
  337.     IF Condition THEN IIF = IfTrue ELSE IIF = IfFalse
  338.  
  339. ' /////////////////////////////////////////////////////////////////////////////
  340.  
  341. FUNCTION IIFSTR$ (Condition, IfTrue$, IfFalse$)
  342.     IF Condition THEN IIFSTR$ = IfTrue$ ELSE IIFSTR$ = IfFalse$
  343.  
  344. ' /////////////////////////////////////////////////////////////////////////////
  345.  
« Last Edit: December 20, 2020, 12:32:43 pm by madscijr »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #11 on: December 20, 2020, 12:32:23 pm »
Quote
I saw some mention of the _MEM or mem copy functions -
how "brittle" is code that relies on it? Will it work across platforms (on Mac or Linux)?
If you can post an example function to copy an array of these

@madscijr

_MEM functions are all cross platform I am pretty sure, maybe _MEM Master will confirm :-))

You got me about copying a UDT Array! ;(  Maybe the _MEM Master will help us with that too. :)

The tedious standard way of copying should be fine for smaller arrays of UDT's if you have a serious sized UDT array with serious application you might have to consider dedicated Data-basing Apps.

I am wondering what you use Dictionary style coding for? (if you dont mind talking about it).

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #12 on: December 20, 2020, 12:50:10 pm »
@madscijr
I am wondering what you use Dictionary style coding for? (if you dont mind talking about it).

I use associative arrays for a million things, they are especially useful in vbscripts and VBA macros for MS Office (you have to reference the microsoft.scripting.runtime, then you can use scripting.dictionary).
But for my purposes in QB64 I'm making a simple video game where you can define the sprites using simple strings, like this:
Code: QB64: [Select]
  1.     ' A 16x16 "sprite":
  2.     sGraphic = ""
  3.     sGraphic = sGraphic + "................" + CHR$(13)
  4.     sGraphic = sGraphic + "................" + CHR$(13)
  5.     sGraphic = sGraphic + "................" + CHR$(13)
  6.     sGraphic = sGraphic + "................" + CHR$(13)
  7.     sGraphic = sGraphic + "................" + CHR$(13)
  8.     sGraphic = sGraphic + "................" + CHR$(13)
  9.     sGraphic = sGraphic + ".........###...." + CHR$(13)
  10.     sGraphic = sGraphic + "....######.#...." + CHR$(13)
  11.     sGraphic = sGraphic + "....#.#..###...." + CHR$(13)
  12.     sGraphic = sGraphic + "................" + CHR$(13)
  13.     sGraphic = sGraphic + "................" + CHR$(13)
  14.     sGraphic = sGraphic + "................" + CHR$(13)
  15.     sGraphic = sGraphic + "................" + CHR$(13)
  16.     sGraphic = sGraphic + "................" + CHR$(13)
  17.     sGraphic = sGraphic + "................" + CHR$(13)
  18.     sGraphic = sGraphic + "................" '+ chr$(13)
  19.  
Where the "#" character is associated with the color black,
"R" with red , "B" with blue, "G" with green, "Y" yellow,
"W" white, "." transparent, etc.
Basically it makes it easy to "draw" sprites inside the QB64 editor,
and kind of visualize what you're getting.
I wanted it to be a "type in program" friendly way of doing it,
without relying on an external graphics program,
or hard to read method of storing the graphic data
(even if it's more efficient). There aren't so many sprites
and complicated graphics to where this would be a problem.
And there can be multiple copies of each sprite, in different color.

I also use constants to store the color values, like
Code: QB64: [Select]
  1. CONST cRed = _RGB32(255, 0, 0)
  2. CONST cLime = _RGB32(0, 255, 0)
  3. CONST cBlue = _RGB32(0, 0, 255)
  4. CONST cYellow = _RGB32(255, 255, 0)
  5. CONST cOrange = _RGB32(255, 165, 0)
  6. CONST cPurple = _RGB32(128, 0, 255)
  7. CONST cBlack = _RGB32(0, 0, 0)
  8. CONST cWhite = _RGB32(255, 255, 255)
  9. CONST cGreen = _RGB32(0, 128, 0)
  10. CONST cEmpty = -1
  11.  
I wanted an easy way to map the color contants to the different letters used in the textual representation of the sprites, so for instance, I could easily remap "G" from lime green #00FF00 to darker green #008000. So I just use an associative array to map the letters to the given colors:
Code: QB64: [Select]
  1. FUNCTION GetColorDictionary% (arrColorValue() AS IntDictionary)
  2.     DIM bResult AS INTEGER
  3.     DIM iErrorCount AS INTEGER
  4.     InitIntDictionary arrColorValue()
  5.     iErrorCount = 0
  6.     iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "R", cRed), 0, 1)
  7.     iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "Y", cYellow), 0, 1)
  8.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "G", cLime), 0, 1)
  9.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "B", cBlue), 0, 1)
  10.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "O", cOrange), 0, 1)
  11.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "P", cPurple), 0, 1)
  12.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "W", cWhite), 0, 1)
  13.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), "#", cBlack), 0, 1)
  14.         iErrorCount = iErrorCount + IIF(SaveIntDictionary%(arrColorValue(), ".", cEmpty), 0, 1)
  15.         'ETC
  16.     GetColorDictionary% = IIF(iErrorCount = 0, TRUE, FALSE)
  17. END SUB ' GetColorDictionary%
  18.  

I know it's not the standard way of doing things, but I just wanted to make this game graphics able to be edited by "drawing" the sprites in simple text inside the source code!

I'm sure I will put dictionaries to use in more conventional ways too! LoL

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #13 on: December 20, 2020, 01:12:04 pm »
OK I wouldn't have guessed graphics ;-)) thanks.

Yeah, I dont think we Basic users are very conventional, more like Do-It-Yourselfers. :)

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: associative arrays / dictionaries in QB64?
« Reply #14 on: December 20, 2020, 01:16:22 pm »
OK I wouldn't have guessed graphics ;-)) thanks.
Yeah, I dont think we Basic users are very conventional, more like Do-It-Yourselfers. :)

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!