Code: Select all
; AArray AKJ 12-Apr-06
; Associative Array or Dictionary
; An 'array' in which you lookup a value by it's name rather than by an index number
; In this implementation, names and values are both case-sensitive strings.
; The method used is crude & probably slow, but may serve as a benchmark for other methods
EnableExplicit
Global AArray$ ; Holds name/value pairs: Chr(1)+<Name>+Chr(2)+<Value>+Chr(3)
Procedure.l AddKey(name$, value$)
; Create a name/value pair or, if the name already exists, associate it with a new value
; Return the number of keys added (i.e. 1, or 0 if the name already exists)
Protected p, q
name$=Chr(1)+Trim(name$)+Chr(2): value$=Trim(value$)
p=FindString(AArray$, name$, 1) ; Point to Chr(1)
If p
p+Len(name$)-1 ; Point to Chr(2)
q=FindString(AArray$, Chr(3), p+1) ; Point to Chr(3)
AArray$=Left(AArray$, p)+value$+Mid(AArray$, q, 99999999)
ProcedureReturn 0
EndIf
AArray$+name$+value$+Chr(3)
ProcedureReturn 1
EndProcedure
Procedure.l DelName(name$)
; Delete the name/value pair with the given name
; Return the number of keys deleted (0 or 1)
Protected p, q
name$=Chr(1)+Trim(name$)+Chr(2)
p=FindString(AArray$, name$, 1) ; Point to Chr(1)
If p
q=FindString(AArray$, Chr(3), p+Len(name$)) ; Point to Chr(3)
AArray$=Left(AArray$, p-1)+Mid(AArray$, q+1, 99999999) ; Delete
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
Procedure.l DelValue(value$)
; Delete all name/value pairs with the given value
; Return the number of keys deleted (>=0)
Protected p, q, r=0
value$=Chr(2)+Trim(value$)+Chr(3)
p=FindString(AArray$, value$, 1) ; Point to Chr(2)
While p
q=p+Len(value$) ; Point to byte after Chr(3)
Repeat: p-1: Until Mid(AArray$, p, 1)=Chr(1) ; Point to preceding Chr(1)
AArray$=Left(AArray$, p-1)+Mid(AArray$, q, 99999999) ; Delete
p=FindString(AArray$, value$, p+1) ; Point to Chr(2)
r+1
Wend
ProcedureReturn r
EndProcedure
Procedure.l CountKeys()
; Return the number of name/value pairs in the associative array
ProcedureReturn CountString(AArray$, Chr(2))
EndProcedure
Procedure.l CountNames(name$)
; Return the number of name/value pairs with the given name
ProcedureReturn CountString(AArray$, Chr(1)+Trim(name$)+Chr(2))
EndProcedure
Procedure.l CountValues(value$)
; Return the number of name/value pairs with the given value
ProcedureReturn CountString(AArray$, Chr(2)+Trim(value$)+Chr(3))
EndProcedure
Procedure.s FindName(name$)
; Return the value associated with the given name, or "" on failure
Protected p, q
name$=Chr(1)+Trim(name$)+Chr(2)
p=FindString(AArray$, name$, 1) ; Point to Chr(1)
If p
p+Len(name$) ; Point to byte after Chr(2)
q=FindString(AArray$, Chr(3), p) ; Point to Chr(3)
ProcedureReturn Mid(AArray$, p, q-p)
EndIf
ProcedureReturn ""
EndProcedure
Procedure.s FindValue(value$, sep$=" ")
; Return all names associated with the given value, else "" on failure
; The names are separated by sep$ (one or more characters)
Protected p, q, r$=""
value$=Chr(2)+Trim(value$)+Chr(3)
q=FindString(AArray$, value$, 1) ; Point to Chr(2)
While q
p=q
Repeat: p-1: Until Mid(AArray$, p, 1)=Chr(1) ; Point to preceding Chr(1)
r$+sep$+Mid(AArray$, p+1, q-p-1)
q=FindString(AArray$, value$, q+Len(value$)) ; Point to Chr(2)
Wend
ProcedureReturn Mid(r$, Len(sep$)+1, 99999999) ; Omit the leading separator
EndProcedure
Procedure.s SortNames(sep$=" ")
; Sort the associative array keys in name order. Also ...
; Return all names in sorted order, separated by sep$ (one or more characters)
Protected NewList names$(), p, q, r$
If Len(AArray$)=0: ProcedureReturn "": EndIf
p=1 ; Point to Chr(1)
Repeat ; Extract AArray$ contents to a linked list
q=FindString(AArray$, Chr(3), p+1) ; Point to Chr(3)
AddElement(names$()): names$()=Mid(AArray$, p+1, q-p) ; Exclude Chr(1), include Chr(3)
p=q+1 ; Point to Chr(1)
Until p>=Len(AArray$)
SortList(names$(), 0) ; Sort the linked list
AArray$="": r$=""
ForEach names$() ; Rebuild AArray$ from the linked list
AArray$+Chr(1)+names$()
r$+sep$+Left(names$(), FindString(names$(), Chr(2),1)-1)
Next names$()
ProcedureReturn Mid(r$, Len(sep$)+1, 99999999) ; Omit the leading separator
EndProcedure
; Test program (value is the number of chars in the name)
Debug "Count 0 = "+Str(CountKeys())
Debug "Add key = "+Str(AddKey("melon","5"))
Debug "Add key = "+Str(AddKey("apple","9")) ; Wrong value of 9; corrected later
Debug "Add key = "+Str(AddKey("orange","6"))
Debug "Add key = "+Str(AddKey("pear","4"))
Debug "Add dup = "+Str(AddKey("apple","5")) ; Corrected value
Debug "Add key = "+Str(AddKey("banana","6"))
Debug "Add dup = "+Str(AddKey("orange","6"))
Debug "Add key = "+Str(AddKey("raspberry","9"))
Debug "Add key = "+Str(AddKey("grape","5"))
Debug "Count 7 = "+Str(CountKeys())
Debug "?N apple= "+FindName("apple")
Debug "?N raspb= "+FindName("raspberry")
Debug "?V 5 = "+FindValue("5", "+")
Debug "?V 6 = "+FindValue("6")
Debug "-N pear = "+Str(DelName("pear"))
Debug "-N pear = "+Str(DelName("pear")) ; Already deleted
Debug "-V 6 = "+Str(DelValue("6")) ; Delete all keys with value "6"
Debug "?V 6 = "+FindValue("6") ; Nothing to find
Debug "Add key = "+Str(AddKey("peach","5"))
Debug "Sort N = ["+SortNames("] [")+"]"
Debug "Count 5 = "+Str(CountKeys())
End
