I need good map class implementation in VBA.
This is my implementation for integer key
Box class:
Private key As Long 'Key, only positive digit
Private value As String 'Value, only
'Value getter
Public Function GetValue() As String
GetValue = value
End Function
'Value setter
Public Function setValue(pValue As String)
value = pValue
End Function
'Ket setter
Public Function setKey(pKey As Long)
Key = pKey
End Function
'Key getter
Public Function GetKey() As Long
GetKey = Key
End Function
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
Map class:
Private boxCollection As Collection
'Init
Private Sub Class_Initialize()
Set boxCollection = New Collection
End Sub
'Destroy
Private Sub Class_Terminate()
Set boxCollection = Nothing
End Sub
'Add element(Box) to collection
Public Function Add(Key As Long, value As String)
If (Key > 0) And (containsKey(Key) Is Nothing) Then
Dim aBox As New Box
With aBox
.setKey (Key)
.setValue (value)
End With
boxCollection.Add aBox
Else
MsgBox ("В словаре уже содержится элемент с ключем " + CStr(Key))
End If
End Function
'Get key by value or -1
Public Function GetKey(value As String) As Long
Dim gkBox As Box
Set gkBox = containsValue(value)
If gkBox Is Nothing Then
GetKey = -1
Else
GetKey = gkBox.GetKey
End If
End Function
'Get value by key or message
Public Function GetValue(Key As Long) As String
Dim gvBox As Box
Set gvBox = containsKey(Key)
If gvBox Is Nothing Then
MsgBox ("Key " + CStr(Key) + " dont exist")
Else
GetValue = gvBox.GetValue
End If
End Function
'Remove element from collection
Public Function Remove(Key As Long)
Dim index As Long
index = getIndex(Key)
If index > 0 Then
boxCollection.Remove (index)
End If
End Function
'Get count of element in collection
Public Function GetCount() As Long
GetCount = boxCollection.Count
End Function
'Get object by key
Private Function containsKey(Key As Long) As Box
If boxCollection.Count > 0 Then
Dim i As Long
For i = 1 To boxCollection.Count
Dim fBox As Box
Set fBox = boxCollection.Item(i)
If fBox.GetKey = Key Then Set containsKey = fBox
Next i
End If
End Function
'Get object by value
Private Function containsValue(value As String) As Box
If boxCollection.Count > 0 Then
Dim i As Long
For i = 1 To boxCollection.Count
Dim fBox As Box
Set fBox = boxCollection.Item(i)
If fBox.GetValue = value Then Set containsValue = fBox
Next i
End If
End Function
'Get element index by key
Private Function getIndex(Key As Long) As Long
getIndex = -1
If boxCollection.Count > 0 Then
For i = 1 To boxCollection.Count
Dim fBox As Box
Set fBox = boxCollection.Item(i)
If fBox.GetKey = Key Then getIndex = i
Next i
End If
End Function
All ok if i insert 1000 pairs key-value. But if 50000, a program freezes.
How i can solve this problem? Or maybe there more better solution?
Main problem with your implementation is that the operation containsKey is quite expensive (O(n) complex) and it is called at every insert and it never breaks even when it “knows” what would be the result.
This might help a little:
...
If fBox.GetKey = Key Then
Set containsKey = fBox
Exit Function
End If
...
In order to reduce the containsKey complexity typical things to do would be
- keep the keys sorted so that you can use binary search instead of linear search
- keep the keys in tree or in a hashed buckets
The most straightforward thing to do would be using the Collection‘s built-in (hopefully optimized) ability to store/retrieve items by a key.
Store:
...
boxCollection.Add Item := aBox, Key := CStr(Key)
...
Retrieve (not tested, based on this answer):
Private Function containsKey(Key As Long) As Box
On Error GoTo err
Set containsKey = boxCollection.Item(CStr(Key))
Exit Function
err:
Set containsKey = Nothing
End Function
See also:
Tags: excelexcel, vba
