Associative array/Iteration: Difference between revisions

no edit summary
(add FreeBASIC)
No edit summary
Line 2,914:
print ("value = %s" % value)</lang>
 
=={{header|QB64}}==
<lang QB64>
'dictionary is not native data type of QB64
' here a dictionary engine using a string to store data
Dim Shared Skey As String * 1, SValue As String * 1, EValue As String * 1
Skey = Chr$(0)
SValue = Chr$(1)
EValue = Chr$(255)
'Demo area---------------->
Dim MyDictionary As String
If ChangeValue(MyDictionary, "a", "Ananas") Then Print "added new couple key value"
If ChangeValue(MyDictionary, "b", "Banana") Then Print "added new couple key value"
If ChangeValue(MyDictionary, "c", "cherry") Then Print "added new couple key value"
If ChangeValue(MyDictionary, "d", "Drake") Then Print "added new couple key value"
If ChangeValue(MyDictionary, "e", "Elm") Then Print "added new couple key value"
If ChangeValue(MyDictionary, "f", "Fire") Then Print "added new couple key value"
Print LenDict(MyDictionary)
Print "to key e there is "; GetDict$(MyDictionary, "e")
Print "to key e there is "; GetDict$(MyDictionary, "a")
If ChangeValue(MyDictionary, "e", "Elephant") Then Print " changed value of key passed"
Print "to key e there is "; GetDict$(MyDictionary, "e")
If Not (EraseKeyValue(MyDictionary, "e")) Then Print " Failed to erase key value passed" Else Print "Erased key value passed"
If GetDict$(MyDictionary, "e") = "" Then Print " No couple key value found for key value 'e'"
If ChangeKey(MyDictionary, "e", "f") = 0 Then
Print "key -a- has value "; GetDict$(MyDictionary, "a")
Print "we change key a to key e "
If ChangeKey(MyDictionary, "a", "e") = -1 Then
Print "key -a- has value "; GetDict$(MyDictionary, "a")
Print "key -e- has value "; GetDict$(MyDictionary, "e")
End If
End If
If InsertCouple(MyDictionary, "c", "m", "mellon") = -1 Then
Print " New couple inserted after key -c- "; GetDict$(MyDictionary, "c")
Print " new couple is key -m- "; GetDict$(MyDictionary, "m")
End If
Print LenDict(MyDictionary)
' End demo area --------------->
End
' it returns value/s for a key
Function GetDict$ (dict As String, Keys As String)
Dim StartK As Integer, StartV As Integer, EndV As Integer
StartK = InStr(dict, Skey + Keys + SValue)
StartV = InStr(StartK, dict, SValue)
EndV = InStr(StartV, dict, EValue)
If StartK = 0 Then GetDict$ = "" Else GetDict = Mid$(dict, StartV + 1, EndV - StartV)
End Function
' it changes value of a key or append the couple key, newvalue if key is new
Function ChangeValue (dict As String, Keys As String, NewValue As String)
ChangeValue = 0
Dim StartK As Integer, StartV As Integer, EndV As Integer
StartK = InStr(dict, Skey + Keys + SValue)
StartV = InStr(StartK, dict, SValue)
EndV = InStr(StartV, dict, EValue)
If StartK = 0 Then
dict = dict + Skey + Keys + SValue + NewValue + EValue
Else
dict = Left$(dict, StartV) + NewValue + Right$(dict, Len(dict) - EndV + 1)
End If
ChangeValue = -1
End Function
'it changes a key if it is in the dictionary
Function ChangeKey (dict As String, Keys As String, NewKey As String)
ChangeKey = 0
Dim StartK As Integer, StartV As Integer
StartK = InStr(dict, Skey + Keys + SValue)
StartV = InStr(StartK, dict, SValue)
If StartK = 0 Then
Print "Key " + Keys + " not found"
Exit Function
Else
dict = Left$(dict, StartK) + NewKey + Right$(dict, Len(dict) - StartV + 1)
End If
ChangeKey = -1
End Function
'it erases the couple key value
Function EraseKeyValue (dict As String, keys As String)
EraseKeyValue = 0
Dim StartK As Integer, StartV As Integer, EndV As Integer
StartK = InStr(dict, Skey + keys + SValue)
StartV = InStr(StartK, dict, SValue)
EndV = InStr(StartV, dict, EValue)
If StartK = 0 Then
Exit Function
Else
dict = Left$(dict, StartK - 1) + Right$(dict, Len(dict) - EndV + 1)
End If
EraseKeyValue = -1
End Function
'it inserts a couple after a defined key, if key is not in dictionary it append couple key value
Function InsertCouple (dict As String, SKeys As String, Keys As String, Value As String)
InsertCouple = 0
Dim StartK As Integer, StartV As Integer, EndV As Integer
StartK = InStr(dict, Skey + SKeys + SValue)
StartV = InStr(StartK, dict, SValue)
EndV = InStr(StartV, dict, EValue)
If StartK = 0 Then
dict = dict + Skey + Keys + SValue + Value + EValue
Else
dict = Left$(dict, EndV) + Skey + Keys + SValue + Value + EValue + Right$(dict, Len(dict) - EndV + 1)
End If
InsertCouple = -1
End Function
Function LenDict (dict As String)
LenDict = 0
Dim a As Integer, count As Integer
If Len(dict) <= 0 Then Exit Function
While a <= Len(dict)
a = InStr(a + 1, dict, EValue)
If a > 0 Then count = count + 1 Else Exit While
Wend
LenDict = count
End Function
 
</lang>
=={{header|R}}==