Author Topic: A demo of Dictionary or hash table made with a string (Rosetta Code)  (Read 3233 times)

0 Members and 1 Guest are viewing this topic.

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Hi guys and gals

going back to school I find a fine exercise
build a dictionary
here a dictionary using a string and delimiters, very simple.
Code: QB64: [Select]
  1. Dim Shared Skey As String * 1, SValue As String * 1, EValue As String * 1
  2. Skey = Chr$(0)
  3. SValue = Chr$(1)
  4. EValue = Chr$(255)
  5. 'Demo area---------------->
  6. Dim MyDictionary As String
  7.  
  8. If PutDict(MyDictionary, "a", "Ananas") Then Print "added new couple key value"
  9. If PutDict(MyDictionary, "b", "Banana") Then Print "added new couple key value"
  10. If PutDict(MyDictionary, "c", "cherry") Then Print "added new couple key value"
  11. If PutDict(MyDictionary, "d", "Drake") Then Print "added new couple key value"
  12. If PutDict(MyDictionary, "e", "Elm") Then Print "added new couple key value"
  13. If PutDict(MyDictionary, "f", "Fire") Then Print "added new couple key value"
  14.  
  15. Print "to key e there is  "; GetDict$(MyDictionary, "e")
  16. Print "to key e there is  "; GetDict$(MyDictionary, "a")
  17. If ChangeValue(MyDictionary, "e", "Elephant") Then Print " changed value of key passed"
  18. Print "to key e there is  "; GetDict$(MyDictionary, "e")
  19. If Not (EraseKeyValue(MyDictionary, "e")) Then Print " Failed to erase key value passed" Else Print "Erased key value passed"
  20. If GetDict$(MyDictionary, "e") = "" Then Print " No couple key value found for key value 'e'"
  21. ' End demo area --------------->
  22.  
  23. Function PutDict (dict As String, keys As String, value As String)
  24.     PutDict = 0
  25.     dict = dict + Skey + keys + SValue + value + EValue
  26.     PutDict = -1
  27.  
  28.  
  29. Function GetDict$ (dict As String, Keys As String)
  30.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  31.     StartK = InStr(dict, Skey + Keys + SValue)
  32.     StartV = InStr(StartK, dict, SValue)
  33.     EndV = InStr(StartV, dict, EValue)
  34.     If StartK = 0 Then GetDict$ = "" Else GetDict = Mid$(dict, StartV + 1, EndV - StartV)
  35.  
  36. Function ChangeValue (dict As String, Keys As String, NewValue As String)
  37.     ChangeValue = 0
  38.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  39.     StartK = InStr(dict, Skey + Keys + SValue)
  40.     StartV = InStr(StartK, dict, SValue)
  41.     EndV = InStr(StartV, dict, EValue)
  42.     If StartK = 0 Then
  43.         StartK = PutDict(dict, Keys, NewValue)
  44.     Else
  45.         dict = Left$(dict, StartV) + NewValue + Right$(dict, Len(dict) - EndV + 1)
  46.     End If
  47.     ChangeValue = -1
  48.  
  49. Function EraseKeyValue (dict As String, keys As String)
  50.     EraseKeyValue = 0
  51.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  52.     StartK = InStr(dict, Skey + keys + SValue)
  53.     StartV = InStr(StartK, dict, SValue)
  54.     EndV = InStr(StartV, dict, EValue)
  55.     If StartK = 0 Then
  56.         Exit Function
  57.     Else
  58.         dict = Left$(dict, StartK - 1) + Right$(dict, Len(dict) - EndV + 1)
  59.     End If
  60.     EraseKeyValue = -1

Play with it.
« Last Edit: April 11, 2021, 05:20:01 pm by TempodiBasic »
Programming isn't difficult, only it's  consuming time and coffee

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: A demo of Dictionary or hash table made with a string (Rosetta Code)
« Reply #1 on: April 11, 2021, 06:19:31 pm »
Hi
with the goal of build a simple dictionary data type with its engine here I post the evolution of a dictionary made by a string with delimeters
Code: QB64: [Select]
  1. Dim Shared Skey As String * 1, SValue As String * 1, EValue As String * 1
  2. Skey = Chr$(0)
  3. SValue = Chr$(1)
  4. EValue = Chr$(255)
  5.  
  6. 'Demo area---------------->
  7. Dim MyDictionary As String
  8.  
  9. If ChangeValue(MyDictionary, "a", "Ananas") Then Print "added new couple key value"
  10. If ChangeValue(MyDictionary, "b", "Banana") Then Print "added new couple key value"
  11. If ChangeValue(MyDictionary, "c", "cherry") Then Print "added new couple key value"
  12. If ChangeValue(MyDictionary, "d", "Drake") Then Print "added new couple key value"
  13. If ChangeValue(MyDictionary, "e", "Elm") Then Print "added new couple key value"
  14. If ChangeValue(MyDictionary, "f", "Fire") Then Print "added new couple key value"
  15. Print LenDict(MyDictionary)
  16. Print "to key e there is  "; GetDict$(MyDictionary, "e")
  17. Print "to key e there is  "; GetDict$(MyDictionary, "a")
  18. If ChangeValue(MyDictionary, "e", "Elephant") Then Print " changed value of key passed"
  19. Print "to key e there is  "; GetDict$(MyDictionary, "e")
  20. If Not (EraseKeyValue(MyDictionary, "e")) Then Print " Failed to erase key value passed" Else Print "Erased key value passed"
  21. If GetDict$(MyDictionary, "e") = "" Then Print " No couple key value found for key value 'e'"
  22. If ChangeKey(MyDictionary, "e", "f") = 0 Then
  23.     Print "key -a- has value "; GetDict$(MyDictionary, "a")
  24.     Print "we change key a to key e "
  25.     If ChangeKey(MyDictionary, "a", "e") = -1 Then
  26.         Print "key -a- has value "; GetDict$(MyDictionary, "a")
  27.         Print "key -e- has value "; GetDict$(MyDictionary, "e")
  28.     End If
  29. If InsertCouple(MyDictionary, "c", "m", "mellon") = -1 Then
  30.     Print " New couple inserted after key -c- "; GetDict$(MyDictionary, "c")
  31.     Print " new couple is  key -m- "; GetDict$(MyDictionary, "m")
  32. Print LenDict(MyDictionary)
  33. ' End demo area --------------->
  34.  
  35.  
  36. ' it returns value/s for a key
  37. Function GetDict$ (dict As String, Keys As String)
  38.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  39.     StartK = InStr(dict, Skey + Keys + SValue)
  40.     StartV = InStr(StartK, dict, SValue)
  41.     EndV = InStr(StartV, dict, EValue)
  42.     If StartK = 0 Then GetDict$ = "" Else GetDict = Mid$(dict, StartV + 1, EndV - StartV)
  43.  
  44. ' it changes value of a key or append the couple key, newvalue if key is new
  45. Function ChangeValue (dict As String, Keys As String, NewValue As String)
  46.     ChangeValue = 0
  47.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  48.     StartK = InStr(dict, Skey + Keys + SValue)
  49.     StartV = InStr(StartK, dict, SValue)
  50.     EndV = InStr(StartV, dict, EValue)
  51.     If StartK = 0 Then
  52.         dict = dict + Skey + Keys + SValue + NewValue + EValue
  53.     Else
  54.         dict = Left$(dict, StartV) + NewValue + Right$(dict, Len(dict) - EndV + 1)
  55.     End If
  56.     ChangeValue = -1
  57.  
  58. 'it changes a key if it is in the dictionary
  59. Function ChangeKey (dict As String, Keys As String, NewKey As String)
  60.     ChangeKey = 0
  61.     Dim StartK As Integer, StartV As Integer
  62.     StartK = InStr(dict, Skey + Keys + SValue)
  63.     StartV = InStr(StartK, dict, SValue)
  64.     If StartK = 0 Then
  65.         Print "Key " + Keys + " not found"
  66.         Exit Function
  67.     Else
  68.         dict = Left$(dict, StartK) + NewKey + Right$(dict, Len(dict) - StartV + 1)
  69.     End If
  70.     ChangeKey = -1
  71.  
  72. 'it erases the couple key value
  73. Function EraseKeyValue (dict As String, keys As String)
  74.     EraseKeyValue = 0
  75.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  76.     StartK = InStr(dict, Skey + keys + SValue)
  77.     StartV = InStr(StartK, dict, SValue)
  78.     EndV = InStr(StartV, dict, EValue)
  79.     If StartK = 0 Then
  80.         Exit Function
  81.     Else
  82.         dict = Left$(dict, StartK - 1) + Right$(dict, Len(dict) - EndV + 1)
  83.     End If
  84.     EraseKeyValue = -1
  85.  
  86. 'it inserts a couple after a defined key, if key is not in dictionary it append couple key value
  87. Function InsertCouple (dict As String, SKeys As String, Keys As String, Value As String)
  88.     InsertCouple = 0
  89.     Dim StartK As Integer, StartV As Integer, EndV As Integer
  90.     StartK = InStr(dict, Skey + SKeys + SValue)
  91.     StartV = InStr(StartK, dict, SValue)
  92.     EndV = InStr(StartV, dict, EValue)
  93.     If StartK = 0 Then
  94.         dict = dict + Skey + Keys + SValue + Value + EValue
  95.     Else
  96.         dict = Left$(dict, EndV) + Skey + Keys + SValue + Value + EValue + Right$(dict, Len(dict) - EndV + 1)
  97.     End If
  98.     InsertCouple = -1
  99.  
  100. Function LenDict (dict As String)
  101.     LenDict = 0
  102.     Dim a As Integer, count As Integer
  103.     If Len(dict) <= 0 Then Exit Function
  104.     While a <= Len(dict)
  105.         a = InStr(a + 1, dict, EValue)
  106.         If a > 0 Then count = count + 1 Else Exit While
  107.     Wend
  108.     LenDict = count

please give a try for feedback. Thanks
Programming isn't difficult, only it's  consuming time and coffee