[Implemented] Dictionary

USCode · Post by **USCode** » Tue Apr 04, 2006 5:53 am

Has anyone ever requested a Dictionary collection library for PureBasic?
This is a very handy construct that maps keys to values and is available in many languages such as Java, RealBasic, Python, even C++:
http://en.wikipedia.org/wiki/Associative_array

Rescator · Post by **Rescator** » Tue Apr 04, 2006 7:47 am

Well! If anyone feel up to coding a ASM implementation or C implementation maybe Fred can add that later

Very good suggestion though, for the time being I'm doing something similar manually. Bit kind of brute force. (iterating through all keys until correct one is found)
Not the most effective way for sure!

EDIT: hash trees are usually the fastest implementation unless I remember wrong! But not that easy to code!

akj · Post by **akj** » Wed Apr 12, 2006 10:48 pm

Here is my attempt at implementing a dictionary (associative array):

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

USCode · Post by **USCode** » Thu Apr 13, 2006 3:10 am

akj wrote:Here is my attempt at implementing a dictionary (associative array):

Thanks akj, it's a start!

Flype · Post by **Flype** » Sat Apr 29, 2006 5:50 am

this is my attemps to implement dictionary.
feel free to update it...

Code: Select all

; Object:  Dictionary (Associative Array)
; Version: 0.1
; Author:  flype
; Requir.  Purebasic 4.0+

EnableExplicit

; AssociativeArray.pbi

Structure DICTIONARY
  key.s
  value.s
EndStructure

Macro dict_dim(dict)
  NewList dict.DICTIONARY()
EndMacro

Procedure.l dict_is(dict.DICTIONARY(), key.s = "")
  If key
    ForEach dict()
      If dict()\key = key
        ProcedureReturn #True
      EndIf
    Next
  Else
    If CountList(dict())
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure
Procedure.l dict_del(dict.DICTIONARY(), key.s = "")
  If key
    ForEach dict()
      If dict()\key = key
        DeleteElement(dict())
        ProcedureReturn #True
      EndIf
    Next
  Else
    ClearList(dict())
  EndIf
EndProcedure
Procedure.l dict_new(dict.DICTIONARY(), key.s, Value.s = "")
  If key
    ForEach dict()
      If dict()\key = key
        ProcedureReturn #False
      EndIf
    Next
    If AddElement(dict())
      dict()\key = key
      dict()\Value = Value
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure
Procedure.l dict_set(dict.DICTIONARY(), key.s, Value.s = "")
  ForEach dict()
    If dict()\key = key
      dict()\Value = Value
      ProcedureReturn #True
    EndIf
  Next
EndProcedure
Procedure.l dict_index(dict.DICTIONARY(), key.s)
  Protected value.s
  ForEach dict()
    If dict()\key = key
      ProcedureReturn ListIndex(dict())
    EndIf
  Next
EndProcedure
Procedure.s dict_value(dict.DICTIONARY(), key.s = "")
  Protected value.s
  ForEach dict()
    If key = "" Or dict()\key = key
      value + dict()\value + ", "
    EndIf
  Next
  ProcedureReturn value
EndProcedure
Procedure.l dict_values(dict.DICTIONARY(), values.s(), key.s = "")
  ForEach dict()
    If key = "" Or dict()\key = key
      If AddElement(values())
        values() = dict()\value
      EndIf
    EndIf
  Next
EndProcedure
Procedure.s dict_key(dict.DICTIONARY(), value.s = "")
  Protected key.s
  ForEach dict()
    If value = "" Or dict()\value = value
      key + dict()\key + ", "
    EndIf
  Next
  ProcedureReturn key
EndProcedure
Procedure.l dict_keys(dict.DICTIONARY(), keys.s(), value.s = "")
  ForEach dict()
    If value = "" Or dict()\value = value
      If AddElement(keys())
        keys() = dict()\key
      EndIf
    EndIf
  Next
EndProcedure
Procedure.l dict_count(dict.DICTIONARY(), value.s = "")
  Protected result.l
  If value
    ForEach dict()
      If dict()\value = value
        result + 1
      EndIf
    Next
  Else
    result = CountList(dict())
  EndIf
  ProcedureReturn result
EndProcedure
Procedure.l dict_sort(dict.DICTIONARY(), options.l, member.l, first.l = 0, last.l = 0)
  If last = 0
    last = CountList(dict())
  ElseIf last < 0
    last = CountList(dict()) + last
  EndIf
  Select member
    Case 0: SortStructuredList(dict(), options, OffsetOf(DICTIONARY\key), #PB_Sort_String, first, last)
    Case 1: SortStructuredList(dict(), options, OffsetOf(DICTIONARY\value), #PB_Sort_String, first, last)
  EndSelect
EndProcedure
Procedure.s dict_implode(dict.DICTIONARY(), op.s, sep.s)
  Protected result.s
  ForEach dict()
    result + dict()\key + op
    result + dict()\value + sep
  Next
  ProcedureReturn result
EndProcedure
Procedure.l dict_explode(dict.DICTIONARY(), string.s, op.s, sep.s)
  Protected i.l, field.s, n = CountString(string, sep) + 1
  For i = 1 To n
    field = StringField(string, i, sep)
    dict_new(dict(), Trim(StringField(field, 1, op)), StringField(field, 2, op))
  Next
  ProcedureReturn CountList(dict())
EndProcedure

; AssociativeArray_TEST.pb

Procedure Main(test.s)
  
  dict_dim(a)
  
  Debug dict_explode(a(), test, "=", " ")
  
  Debug dict_count(a())
  Debug dict_count(a(), "yes")
  
  Debug dict_index(a(), "revision")
  
  Debug dict_key(a(), "11")
  Debug dict_value(a(), "os")
  
  Debug dict_key(a())
  Debug dict_value(a())
  
  Debug dict_implode(a(), "-->", "  ///  ")
  
  dict_sort(a(), 0, 0)
  
  Debug dict_implode(a(), "-->", "  ///  ")
  
  dict_sort(a(), 0, 1)
  
  Debug dict_implode(a(), "-->", "  ///  ")
  
EndProcedure

Main("name=purebasic version=4.0 revision=11 os=windows registered=yes uptodate=yes")

USCode · Post by **USCode** » Sat Apr 29, 2006 8:56 pm

Thanks Flype. Unfortunately, I can't get your code to compile with PB4B11, PBCompiler.exe keeps abending out ... anyone else experiencing this problem?
If so then I'll post a bug report with Fred...

Flype · Post by **Flype** » Sun Apr 30, 2006 8:44 am

did you downloaded from www.purebasic.com/beta/ the files provided by fred ? maybe... because it works well for me :roll:

USCode · Post by **USCode** » Sun Apr 30, 2006 6:20 pm

:roll:

Flype · Post by **Flype** » Sun Apr 30, 2006 9:04 pm

uscode, where (lines) does it fail ?

GedB · Post by **GedB** » Sun Apr 30, 2006 9:16 pm

Fred has said that its on his todo list:

http://www.purebasic.fr/english/viewtopic.php?t=17664

USCode · Post by **USCode** » Mon May 01, 2006 12:04 am

Flype wrote:uscode, where (lines) does it fail ?

After I hit Compile/Run, this is all I get back, no error lines, etc. As I said before, the PB Compiler itself is abending:

Flype · Post by **Flype** » Wed Jun 27, 2007 10:42 am

hi, sorry to bumping this thread but does my 'associative array' include still crash for some of us ?

i've tested with the lastest pb, it's ok (it never crashed at home for me).

Dare · Post by **Dare** » Wed Jun 27, 2007 10:47 am

Hi Flype

Doesn't crash here. Win XP Pro

bembulak · Post by **bembulak** » Wed Jun 27, 2007 11:35 am

Works like a charm on Win XP Pro PB 4.10 beta 2 and Ubuntu Gnu/Linux Feisty Fawn 7.04 PB 4.02.