I often find myself abusing dictionary objects just for the exist method like this,
For Each x in Something
If Not dict.Exists(x) Then dict.Add x, False
Next x
Then just exploit the .Exists(x)
method. It happens often enough that I thought it merited it's own class.
Instead of composing Scripting.Dictionary
, I decided to just maintain a sorted list of unique items. Usage is simple; unique items are inserted into the collection sorted. Non-unique items are not added.
Attributes
Let's just get this out of the way. Attribute VB_PredeclaredId
must be set to True
and NewEnum
allows the class to be iterable. I still haven't found a way to replicate this using an array instead of a collection. With an array I could offload some of my code to my standard library, but then this wouldn't be standalone or portable.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1
END
Attribute VB_Name = "UniqueList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private list As Collection
Public Sub Class_Initialize()
Set list = New Collection
End Sub
Public sub Class_Terminate()
Set list = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = list.[_NewEnum]
End Property
Data Manipulation
Public Sub Add(ByVal element As Variant)
If IsEmpty Then
list.Add element
Exit Sub
End If
Dim index As Long
index = LocateIndex(element)
If (list(index) > element) Then
list.Add element, Before:=index
ElseIf list(index) < element Then
list.Add element, After:=index
End If
End Sub
Public Sub Merge(ByVal list_ As Variant)
Dim element As Variant
For Each element In list_
Add element
Next element
End Sub
Public Sub Remove(ByVal element As Variant)
Dim index As Long
index = LocateIndex(element)
If (list(index) = element) Then list.Remove index
End Sub
Public Sub Clear()
Set list = Nothing
Set list = New Collection
End Sub
Introspection
Note I don't implement an Item(x)
method. I don't want users to be able to scramble the data.
Public Function Exists(ByVal element As Variant) As Boolean
Exists = (element = list(LocateIndex(element)))
End Function
Public Function Count() As Long
Count = list.Count
End Function
Public Function IsEmpty() As Boolean
IsEmpty = (Count = 0)
End Function
Searching
The only private method is a binary search that returns where the element is or where it should be.
Private Function LocateIndex(ByVal element As Variant) As Long
Dim upper As Long
upper = Count
Dim lower As Long
lower = 1
While lower < upper
Dim middle As Long
middle = (lower + upper) \ 2
If list(middle) >= element Then
upper = middle
Else
lower = middle + 1
End If
Wend
LocateIndex = upper
End Function