QB64.org Forum

Active Forums => Programs => Topic started by: TempodiBasic on April 05, 2021, 08:10:03 pm

Title: A demo of Dictionary or hash table made with a string (Rosetta Code)
Post by: TempodiBasic on April 05, 2021, 08:10:03 pm

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. End
23.  
24. Function PutDict (dict As String, keys As String, value As String)
25.     PutDict = 0
26.     dict = dict + Skey + keys + SValue + value + EValue
27.     PutDict = -1
28. End Function
29.  
30.  
31. Function GetDict$ (dict As String, Keys As String)
32.     Dim StartK As Integer, StartV As Integer, EndV As Integer
33.     StartK = InStr(dict, Skey + Keys + SValue)
34.     StartV = InStr(StartK, dict, SValue)
35.     EndV = InStr(StartV, dict, EValue)
36.     If StartK = 0 Then GetDict$ = "" Else GetDict = Mid$(dict, StartV + 1, EndV - StartV)
37. End Function
38.  
39. Function ChangeValue (dict As String, Keys As String, NewValue As String)
40.     ChangeValue = 0
41.     Dim StartK As Integer, StartV As Integer, EndV As Integer
42.     StartK = InStr(dict, Skey + Keys + SValue)
43.     StartV = InStr(StartK, dict, SValue)
44.     EndV = InStr(StartV, dict, EValue)
45.     If StartK = 0 Then
46.         StartK = PutDict(dict, Keys, NewValue)
47.     Else
48.         dict = Left$(dict, StartV) + NewValue + Right$(dict, Len(dict) - EndV + 1)
49.     End If
50.     ChangeValue = -1
51. End Function
52.  
53. Function EraseKeyValue (dict As String, keys As String)
54.     EraseKeyValue = 0
55.     Dim StartK As Integer, StartV As Integer, EndV As Integer
56.     StartK = InStr(dict, Skey + keys + SValue)
57.     StartV = InStr(StartK, dict, SValue)
58.     EndV = InStr(StartV, dict, EValue)
59.     If StartK = 0 Then
60.         Exit Function
61.     Else
62.         dict = Left$(dict, StartK - 1) + Right$(dict, Len(dict) - EndV + 1)
63.     End If
64.     EraseKeyValue = -1
65. End Function

Play with it.

Title: Re: A demo of Dictionary or hash table made with a string (Rosetta Code)
Post by: TempodiBasic 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. End If
30. If InsertCouple(MyDictionary, "c", "m", "mellon") = -1 Then
31.     Print " New couple inserted after key -c- "; GetDict$(MyDictionary, "c")
32.     Print " new couple is  key -m- "; GetDict$(MyDictionary, "m")
33. End If
34. Print LenDict(MyDictionary)
35. ' End demo area --------------->
36. End
37.  
38.  
39. ' it returns value/s for a key
40. Function GetDict$ (dict As String, Keys As String)
41.     Dim StartK As Integer, StartV As Integer, EndV As Integer
42.     StartK = InStr(dict, Skey + Keys + SValue)
43.     StartV = InStr(StartK, dict, SValue)
44.     EndV = InStr(StartV, dict, EValue)
45.     If StartK = 0 Then GetDict$ = "" Else GetDict = Mid$(dict, StartV + 1, EndV - StartV)
46. End Function
47.  
48. ' it changes value of a key or append the couple key, newvalue if key is new
49. Function ChangeValue (dict As String, Keys As String, NewValue As String)
50.     ChangeValue = 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.         dict = dict + Skey + Keys + SValue + NewValue + EValue
57.     Else
58.         dict = Left$(dict, StartV) + NewValue + Right$(dict, Len(dict) - EndV + 1)
59.     End If
60.     ChangeValue = -1
61. End Function
62.  
63. 'it changes a key if it is in the dictionary
64. Function ChangeKey (dict As String, Keys As String, NewKey As String)
65.     ChangeKey = 0
66.     Dim StartK As Integer, StartV As Integer
67.     StartK = InStr(dict, Skey + Keys + SValue)
68.     StartV = InStr(StartK, dict, SValue)
69.     If StartK = 0 Then
70.         Print "Key " + Keys + " not found"
71.         Exit Function
72.     Else
73.         dict = Left$(dict, StartK) + NewKey + Right$(dict, Len(dict) - StartV + 1)
74.     End If
75.     ChangeKey = -1
76. End Function
77.  
78. 'it erases the couple key value
79. Function EraseKeyValue (dict As String, keys As String)
80.     EraseKeyValue = 0
81.     Dim StartK As Integer, StartV As Integer, EndV As Integer
82.     StartK = InStr(dict, Skey + keys + SValue)
83.     StartV = InStr(StartK, dict, SValue)
84.     EndV = InStr(StartV, dict, EValue)
85.     If StartK = 0 Then
86.         Exit Function
87.     Else
88.         dict = Left$(dict, StartK - 1) + Right$(dict, Len(dict) - EndV + 1)
89.     End If
90.     EraseKeyValue = -1
91. End Function
92.  
93. 'it inserts a couple after a defined key, if key is not in dictionary it append couple key value
94. Function InsertCouple (dict As String, SKeys As String, Keys As String, Value As String)
95.     InsertCouple = 0
96.     Dim StartK As Integer, StartV As Integer, EndV As Integer
97.     StartK = InStr(dict, Skey + SKeys + SValue)
98.     StartV = InStr(StartK, dict, SValue)
99.     EndV = InStr(StartV, dict, EValue)
100.     If StartK = 0 Then
101.         dict = dict + Skey + Keys + SValue + Value + EValue
102.     Else
103.         dict = Left$(dict, EndV) + Skey + Keys + SValue + Value + EValue + Right$(dict, Len(dict) - EndV + 1)
104.     End If
105.     InsertCouple = -1
106. End Function
107.  
108. Function LenDict (dict As String)
109.     LenDict = 0
110.     Dim a As Integer, count As Integer
111.     If Len(dict) <= 0 Then Exit Function
112.     While a <= Len(dict)
113.         a = InStr(a + 1, dict, EValue)
114.         If a > 0 Then count = count + 1 Else Exit While
115.     Wend
116.     LenDict = count
117. End Function

please give a try for feedback. Thanks

Text Only | Text with Attachments