6
\$\begingroup\$

I've created a class that creates key->value pairs but also value->key pairs - i.e. a reversible hash-map. This is because I want to be able to switch between corresponding members of 2 enums with different values, or between an enum and the text representation of its members.

My approach is to wrap two Scripting.Dictionaries to create the reversible pairing - be sure to reference Microsoft Scripting Runtime (scrrun.dll) *

*Does RD provide a way to annotate references?

Predeclared Class: TwoWayMapping

'@Folder("Operator Framework.Common")
'@IgnoreModule IndexedDefaultMemberAccess: It's fine for collections I think

Option Explicit
'@PredeclaredId

Private Type mappingData
    AtoB As New Dictionary                       'Use dictionary as this allows any item as key, not just strings as with collections
    BtoA As New Dictionary                       'Auto-instantiate so we don't need growMapping to worry about whether the map was initialised
End Type

Public Enum gtMappingErrors
    [_ErrBase] = 1                               'set to a different value for each class in a project
    mismatchedLengthError = vbObjectError + [_ErrBase]
    setsNotIterableError
    valueNotInMapError
End Enum

Private this As mappingData

Public Function Create(ByVal iterableA As Variant, ByVal iterableB As Variant) As TwoWayMapping
    With New TwoWayMapping
        .growMapping iterableA, iterableB
        Set Create = .Self
    End With
End Function

Friend Property Get Self() As TwoWayMapping
    Set Self = Me
End Property

'@Description("Create key - value pairs mapping items from A to B (and vice-versa) based on each item's index within the collection. iterableA and iterableB should be ordered iterables of equal length. Adds to existing mapping")
Public Sub growMapping(ByVal iterableA As Variant, ByVal iterableB As Variant)
    Const errorSourceName As String = "growMapping" 'CHECK
    
    'need data to be in some form that can be indexed, as For..Each only operates on one at a time
    On Error GoTo readIterableFail
    Dim aValues As Collection
    Set aValues = collectionFromIterable(iterableA)
    
    Dim bValues As Collection
    Set bValues = collectionFromIterable(iterableB)
    
    On Error GoTo cleanFail
    If aValues.Count <> bValues.Count Then raiseError mismatchedLengthError, errorSourceName
    
    Dim i As Long
    For i = 1 To aValues.Count
        this.AtoB.Add aValues(i), bValues(i)
        this.BtoA.Add bValues(i), aValues(i)
    Next i
    Exit Sub
    
readIterableFail:
    Const objectNotIterableError As Long = 438   'object does not support method
    Const typeNotIterableError As Long = 13      'type mismatch
    Select Case Err.Number
        Case objectNotIterableError, typeNotIterableError
            raiseError setsNotIterableError, errorSourceName
            
        Case Else
            raiseError Err.Number, errorSourceName
            
    End Select
    Resume                                       'comment out error raising and break here to debug
    
cleanFail:
    raiseError Err.Number, errorSourceName
    Resume                                       'comment out error raising and break here to debug
    
End Sub

Private Property Get collectionFromIterable(ByVal iterable As Variant) As Collection
    Dim item As Variant
    Dim result As New Collection                 'auto-instantiate so we always return a valid collection, even if no members
    For Each item In iterable
        result.Add item
    Next item
    Set collectionFromIterable = result
End Property

Public Property Get AfromB(ByVal bValue As Variant) As Variant
    Const errorSourceName As String = "AfromB"   'CHECK
    If this.BtoA.Exists(bValue) Then
        Assign(AfromB) = this.BtoA(bValue)
    Else
        raiseError valueNotInMapError, errorSourceName
    End If
End Property

Public Property Get BfromA(ByVal aValue As Variant) As Variant
    Const errorSourceName As String = "BfromA"   'CHECK
    If this.AtoB.Exists(aValue) Then             'without this check, aValue is silently added to the dictionary which is probably not what we want
        Assign(BfromA) = this.AtoB(aValue)
    Else
        raiseError valueNotInMapError, errorSourceName
    End If
End Property

Private Sub raiseError(ByVal errNum As gtMappingErrors, Optional ByVal sourceMethod As String = vbNullString)
    Select Case errNum                           'overwrite description with custom error text - case else would be keep default and rethrow error
        Case gtMappingErrors.mismatchedLengthError
            Err.Description = "iterableA and iterableB must have a 1 to 1 correspondence (i.e. must have the same length)"
            
        Case gtMappingErrors.setsNotIterableError
            Err.Description = "One of iterableA and iterableB is not iterable. For single values, wrap in Array()"
          
        Case gtMappingErrors.valueNotInMapError
            Err.Description = "That value cannot be found in the map, ensure it is of the same data type as the original keys"
            
    End Select
    'REVIEW: does Source actually do anything?
    Err.Raise errNum, Source:=IIf(sourceMethod = vbNullString, TypeName(Me), printf("{0}.{1}", TypeName(Me), sourceMethod))
End Sub

which references some functions in a standard module:

'@Ignore WriteOnlyProperty: This is a creative use of Property to get a nice syntax, not really a proper property accessor
'codereview.stackexchange.com/q/231790 - "Assign a variant to a variant"
Public Property Let Assign(ByRef variable As Variant, ByVal value As Variant)
    If IsObject(value) Then
        Set variable = value
    Else
        variable = value
    End If
End Property

'stackoverflow.com/a/17233834 - "Is there an equivalent of printf or String.Format in Excel"
Public Function printf(ByVal mask As String, ParamArray tokens()) As String
    Dim i As Long
    For i = 0 To UBound(tokens)
        mask = Replace$(mask, "{" & i & "}", tokens(i))
    Next
    printf = mask
End Function

Examples

Download the class here - for a quick demo of how it works:

Dim map As TwoWayMapping
Set map = TwoWayMapping.Create([A1:A3].value, [B1:B3].value)
Debug.Assert map.BfromA([A2].value) = [B2].value
Debug.Assert map.AfromB([B3].value) = [A3].value
Debug.Assert map.AfromB([A1].value) <> [B3].value

Or as as a more realistic (if somewhat contrived) example, consider this:

Option Explicit

Private Enum systemConstants
    memoryReadable = 17
    memoryWriteable = 101
    memoryExecutable = 32
End Enum

Public Enum memoryConstants
    mcReadable = 2 ^ 0
    mcWriteable = 2 ^ 1
    mcExecutable = 2 ^ 2
End Enum

Dim enumToTextMap As TwoWayMapping
Dim intellisenseToSystemConstMap As TwoWayMapping

Sub test()
    'initialise maps
    Set enumToTextMap = TwoWayMapping.Create( _
                        Array(memoryReadable, memoryWriteable, memoryExecutable), _
                        Array("Readable", "Writeable", "Executable"))
                        
    Set intellisenseToSystemConstMap = TwoWayMapping.Create( _
                                       Array(mcReadable, mcWriteable, mcExecutable), _
                                       Array(memoryReadable, memoryWriteable, memoryExecutable))
                                       
    setMemoryStuff mcReadable + mcExecutable
                                       
End Sub

Private Sub setMemoryStuff(ByVal setting As memoryConstants)
    Dim enumExponent As Long
    For enumExponent = 0 To 2                    'loop through enum to see what was selected
        If setting And 2 ^ enumExponent Then
            apiSetMemoryProtection intellisenseToSystemConstMap.BfromA(2 ^ enumExponent)
        End If
    Next enumExponent
End Sub

Private Sub apiSetMemoryProtection(ByVal protectionConst As systemConstants)
    Debug.Print "Setting memory to "; enumToTextMap.BfromA(protectionConst), "Intellisense value was: "; intellisenseToSystemConstMap.AfromB(protectionConst)
End Sub

which prints

Setting memory to Readable                Intellisense value was:  1 
Setting memory to Executable              Intellisense value was:  4 

How does this look? Where can my comments be improved, or the functionality made better - are there any methods missing? Is the error handling alright? What about organisation of code within the module?

Any feedback small or big would be much appreciated! I chose to post this because I think it reflects my current style in a small package, so would be good to hear if I've fallen into any bad habits along the way:)

\$\endgroup\$
2
\$\begingroup\$

In order to work through your own code, I ended up designing and implementing my own version of two-way mapping. Interestingly, the designs are fairly similar. My focus of this review is on the overall implementation of the concept, as your code itself is clear and straightforward.

My original thought was to use only one Dictionary but eventually ended up with the two Dictionary design similar to yours. My deviation was to implement an interface that is as close to a standard Dictionary as possible. Also, I did not use a pre-declared class or auto-instantiated Dictionary instances so the object could be "reset" or reused.

Class Module: TwoWayMap

 Option Explicit

Public Enum DataSet
    A
    B
End Enum

Private Type InternalData
    setA As Dictionary
    setB As Dictionary
End Type
Private this As InternalData

Private Enum TwoWayMapErrors
    [_First] = vbObject + 900
    ObjectNotAllowed
    KeyExists
    KeyDoesNotExist
    ValueExists
    ArraySizeMismatch
    [_Last]
End Enum

Public Property Get Count(Optional ByVal WhichSet As DataSet = DataSet.A) As Long
    Count = iff(WhichSet = A, this.setA.Count, this.setB.Count)
End Property

Public Property Get Keys(Optional ByVal WhichSet As DataSet = DataSet.A) As Variant
    Keys = IIf(WhichSet = A, this.setA.Keys, this.setB.Keys)
End Property

Public Property Get Exists(ByVal Key As Variant, _
                           Optional ByVal WhichSet As DataSet = DataSet.A) As Boolean
    Dim thisKey As String
    thisKey = IIf(VarType(Key) = vbString, Key, CStr(Key))
    Exists = IIf(WhichSet = A, this.setA.Exists(thisKey), this.setB.Exists(thisKey))
End Property

Public Sub Add(ByVal Key As String, ByRef Value As Variant, _
               Optional ByVal WhichSet As DataSet = DataSet.A)
    If IsObject(Value) Then
        Err.Raise ObjectNotAllowed, Source:="TwoWayMap.Add", _
                  Description:="ERROR in TwoWayMap.Add: Value must not be an object!"
    End If

    Dim firstSet As Dictionary
    Dim secondSet As Dictionary
    Set firstSet = IIf(WhichSet = A, this.setA, this.setB)
    Set secondSet = IIf(WhichSet = A, this.setB, this.setA)

    If firstSet.Exists(Key) Then
        Err.Raise KeyExists, Source:="TwoWayMap.Add", _
                  Description:="ERROR in TwoWayMap.Add: Key already exists in Map!"
    End If
    If secondSet.Exists(CStr(Value)) Then
        Err.Raise ValueExists, Source:="TwoWayMap.Add", _
                  Description:="ERROR in TwoWayMap.Add: Value already exists in Map!"
    End If

    AddToSet IIf(WhichSet = DataSet.A, DataSet.A, DataSet.B), Key, Value
    AddToSet IIf(WhichSet = DataSet.A, DataSet.B, DataSet.A), Value, Key
End Sub

Public Property Get Item(ByVal Key As Variant, _
                         Optional ByVal WhichSet As DataSet = DataSet.A) As Variant
    Dim thisKey As String
    thisKey = IIf(VarType(Key) = vbString, Key, CStr(Key))
    Dim theSet As Dictionary
    Set theSet = IIf(WhichSet = A, this.setA, this.setB)
    If Not theSet.Exists(Key) Then
        Err.Raise KeyDoesNotExist, Source:="TwoWayMap.Item", _
                  Description:="ERROR in TwoWayMap.Item(Get): Key does NOT exist in Map!"
    End If
    Item = theSet(CStr(thisKey))
End Property

Public Property Let Item(ByVal Key As Variant, _
                         Optional ByVal WhichSet As DataSet = DataSet.A, _
                         ByRef Value As Variant)
    Dim thisKey As String
    thisKey = IIf(VarType(Key) = vbString, Key, CStr(Key))
    Dim theSet As Dictionary
    Set theSet = IIf(WhichSet = A, this.setA, this.setB)
    If Not theSet.Exists(Key) Then
        Err.Raise KeyDoesNotExist, Source:="TwoWayMap.Item", _
                  Description:="ERROR in TwoWayMap.Item(Let): Key does NOT exist in Map!"
    End If
    theSet(CStr(thisKey)) = Value
End Property

Public Function Create(ByVal arrayA As Variant, ByVal arrayB As Variant) As TwoWayMap
    Dim lengthA As Long
    Dim lengthB As Long
    lengthA = UBound(arrayA) - LBound(arrayA) + 1
    lengthB = UBound(arrayB) - LBound(arrayB) + 1
    If lengthA <> lengthB Then
        Err.Raise ArraySizeMismatch, Source:="TwoWayMap.Create", _
                  Description:="ERROR in TwoWayMap.Create: Array sizes are not the same!"
    End If

    this.setA.RemoveAll
    this.setB.RemoveAll

    Dim j As Long
    j = LBound(arrayB)

    Dim i As Long
    For i = LBound(arrayA) To UBound(arrayA)
        AddToSet A, arrayA(i), arrayB(j)
        AddToSet B, arrayB(j), arrayA(i)
        j = j + 1
    Next i
    Set Create = Me
End Function

Private Sub AddToSet(ByVal WhichSet As DataSet, ByVal Key As Variant, _
                     ByVal Value As Variant)
    Dim theSet As Dictionary
    Set theSet = IIf(WhichSet = A, this.setA, this.setB)
    theSet.Add CStr(Key), Value
End Sub

Private Sub Class_Initialize()
    Set this.setA = New Dictionary
    Set this.setB = New Dictionary
End Sub

Code Module: Module1

Option Explicit

Sub TestMyMap()
    Dim thisMap As TwoWayMap
    Set thisMap = New TwoWayMap
    thisMap.Add "vbBlue", vbBlue
    thisMap.Add "vbRed", vbRed
    thisMap.Add "vbGreen", vbGreen

    Debug.Print "------new run----------"
    Dim Key As Variant
    For Each Key In thisMap.Keys
        Debug.Print "Key: " & Key & ", Value: " & thisMap.Item(Key)
    Next Key

    For Each Key In thisMap.Keys(B)
        Debug.Print "Key: " & Key & ", Value: " & thisMap.Item(Key, B)
    Next Key

End Sub

I'm concerned that I haven't covered all the edge cases yet, but I may still look at the design and see what could be improved.

| improve this answer | |
\$\endgroup\$
2
\$\begingroup\$

There are lots of really good things going on here. Particularly your use of a private type to encapsulate internal fields, enums, declaration of variables close to where they are being used, and overall code readability.

Saying that, there are some OOP best practices that I will mention below. And just as @PeterT has done, I implemented my own version of your code, mostly to help demonstrate how I would apply best practices to your implementation.

Naming:

  • You yourself call "TwoWayMapping" a reversible hash-map, so I say just call it that.
  • As for variable and method names, I would encourage the idea of thinking in terms of key(s) and item(s) instead of A(s) or B(s). My reasoning is the shear fact that member names like key(s)/item(s) are universally understood by developers. Also, class members and method names should be PascalCase, while variables should be camelCase. SCREAM_CASE for constants ensures that what you are looking at is most definitely a constant, but I have seen various opinions on the subject which agree/disagree.

Various:

  • Assign is devilishly clever and I am totally stealing it; however, the fact that it is declared in a standard module and not in the class itself, is bad practice. The same can be said for Printf.

  • Methods should be performing work, not properties. So collectionFromIterable should be a method, not a property.

  • I believe that I have seen the usage of Create which uses a Self instance before and it is also very clever, but consider using a more standard Factory pattern. The Factory class should be predeclared and named like TwoWayMappingFactory. You can then use it to instantiate TwoWayMapping by calling the Create factory method. You can also prevent client code from creating non-default instances of the Factory class via the set foo = New TwoWayMappingFactory (see the TestNonDefaultInstance in the Tests section below) by using a clever technique that I learned from @MathieuGuindon.

ReversibleHashMapFactory

'@Folder("Operator Framework.Common")
'@PredeclaredId

Option Explicit

Public Enum ReversibleHashMapFactoryErrors
    NonDefaultInstance = vbObjectError + 1024
End Enum

Private Sub Class_Initialize()
    ThrowIfNonDefaultInstance
End Sub

Public Function Create(ByVal Keys As Variant, ByVal Items As Variant) As ReversibleHashMap

    Set Create = New ReversibleHashMap
    With Create
        .MapPairs Keys, Items
    End With

End Function

Private Property Get IsDefaultInstance() As Boolean
    IsDefaultInstance = Me Is ReversibleHashMapFactory
End Property

Private Sub ThrowIfNonDefaultInstance()
    If Not IsDefaultInstance Then Err.Raise ReversibleHashMapFactoryErrors.NonDefaultInstance, _
                                  TypeName(Me), "Non-default instances of the factory class are invalid"
End Sub


ReversibleHashMap

'@Folder("Operator Framework.Common")
Option Explicit

Public Enum ReversibleHashMapErrors
    MismatchedLength = vbObjectError + 1024
    SetsNotIterable
    KeyDoesNotExist
    ItemDoesNotExist
End Enum

Private Const MISMATCH_LENGTH_ERROR As String = "keys and items must have a 1 to 1 correspondence (i.e. must have the same length)"
Private Const SETS_NOT_ITERABLE_ERROR As String = "One of keys and items is not iterable. For single values, wrap in Array()"
Private Const VALUE_DOES_NOT_EXIST_ERROR As String = "value cannot be found in the map, ensure it is of the same data type as the original "

Private Const OBJECT_DOES_NOT_SUPPORT_RUNTIME_ERROR As Long = 438   'object does not support method
Private Const TYPE_MISMATCH_RUNTIME_ERROR As Long = 13              'type mismatch

Private Type TReversibleHashMap
    keysDict As Object
    itemsDict As Object
End Type

Private this As TReversibleHashMap

'*****************************************************************************************
'Public Methods
'*****************************************************************************************
Public Sub MapPairs(ByVal Keys As Variant, ByVal Items As Variant)

    Const METHOD_NAME As String = "MapValues"

    Dim keysColl As Collection
    Set keysColl = IterableToCollection(Keys)

    Dim itemsColl As Collection
    Set itemsColl = IterableToCollection(Items)

    If keysColl.Count <> itemsColl.Count Then ThrowError MismatchedLength, METHOD_NAME

    Dim i As Long
    For i = 1 To keysColl.Count
        MapPair keysColl(i), itemsColl(i)
    Next i

End Sub

Public Sub MapPair(ByVal key As Variant, ByVal item As Variant)

    Const METHOD_NAME As String = "MapValue"

    On Error GoTo CleanFail
    this.keysDict.Add key, item
    this.itemsDict.Add item, key

CleanExit:
    Exit Sub

CleanFail:
    ThrowError Err.Number, METHOD_NAME
    Resume CleanExit

End Sub

Public Property Get Count() As Long

    If this.keysDict.Count = this.itemsDict.Count Then
        Count = this.keysDict.Count

    Else
        ThrowError MismatchedLength, "Count"

    End If

End Property

Public Property Get Keys() As Variant
    Keys = this.keysDict.Keys
End Property

Public Property Get Items() As Variant
    Items = this.itemsDict.Keys
End Property

Public Function KeyExists(ByVal key As Variant) As Boolean
    KeyExists = this.keysDict.Exists(key)
End Function

Public Function ItemExists(ByVal item As Variant) As Boolean
    ItemExists = this.itemsDict.Exists(item)
End Function

Public Function PairExists(ByVal key As Variant, ByVal item As Variant) As Boolean
    PairExists = (KeyExists(key) Or ItemExists(item))
End Function

Public Function GetKey(ByVal item As Variant) As Variant

    Const METHOD_NAME As String = "GetKey"   

    If this.itemsDict.Exists(item) Then
        AssignValue(GetKey) = this.itemsDict(item)
    Else
        ThrowError ReversibleHashMapErrors.KeyDoesNotExist, METHOD_NAME
    End If

End Function

Public Function GetItem(ByVal key As Variant) As Variant

    Const METHOD_NAME As String = "GetItem"

    If this.keysDict.Exists(key) Then
        AssignValue(GetItem) = this.keysDict(key)
    Else
        ThrowError ReversibleHashMapErrors.ItemDoesNotExist, METHOD_NAME
    End If

End Function


'*****************************************************************************************
'Private Methods / Properties
'*****************************************************************************************
Private Sub Class_Initialize()
    Set this.keysDict = CreateObject("Scripting.Dictionary")
    Set this.itemsDict = CreateObject("Scripting.Dictionary")
End Sub

Private Function IterableToCollection(ByVal iterable As Variant) As Collection

    Select Case VarType(iterable)

        Case (vbArray + vbVariant)  '8204; https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/vartype-function
            Set IterableToCollection = ArrayToCollection(iterable)

        Case vbObject
            Set IterableToCollection = ObjectToCollection(iterable)

    End Select

End Function

Private Function ArrayToCollection(ByRef variantArray As Variant) As Collection

    Const METHOD_NAME As String = "ArrayToCollection"

    ValidateArrayDimensions variantArray, METHOD_NAME

    Dim result As Collection
    Set result = New Collection

    Dim i As Long

    On Error GoTo CleanFail
    Select Case NumberOfArrayDimensions(variantArray)
        Case 1
            For i = LBound(variantArray) To UBound(variantArray)
                result.Add variantArray(i)
            Next i

        Case 2
            For i = LBound(variantArray, 1) To UBound(variantArray, 1)
                result.Add variantArray(i, 1)
            Next i

    End Select

    Set ArrayToCollection = result


CleanExit:
    Exit Function

CleanFail:
    ManageIterableError Err.Number, METHOD_NAME
    Resume CleanExit

End Function

Private Function ObjectToCollection(ByRef obj As Variant) As Collection

    Const METHOD_NAME As String = "ObjectToCollection"

    Dim item As Variant
    Dim result As Collection
    Set result = New Collection

    On Error GoTo CleanFail
    For Each item In obj
        result.Add item
    Next

    Set ObjectToCollection = result

CleanExit:
    Exit Function

CleanFail:
    ManageIterableError Err.Number, METHOD_NAME
    Resume CleanExit

End Function


Private Property Let AssignValue(ByRef outValue As Variant, ByVal value As Variant)

    If IsObject(value) Then
        Set outValue = value
    Else
        outValue = value
    End If

End Property


'*****************************************************************************************
'Error Handling
'*****************************************************************************************
Private Sub ValidateArrayDimensions(ByRef variantArray As Variant, ByVal methodName As String)

    Dim dimensions As Long
    dimensions = NumberOfArrayDimensions(variantArray)
    Select Case dimensions
        Case Is > 2
            ThrowError ReversibleHashMapErrors.SetsNotIterable, methodName
        Case Is = 2
            If IsMultiColumnArray(variantArray) Then ThrowError ReversibleHashMapErrors.SetsNotIterable, methodName

    End Select

End Sub

Private Sub ManageIterableError(ByVal errorNumber As Long, ByVal methodName As String)

    Select Case errorNumber
        Case OBJECT_DOES_NOT_SUPPORT_RUNTIME_ERROR, TYPE_MISMATCH_RUNTIME_ERROR
            ThrowError ReversibleHashMapErrors.SetsNotIterable, methodName

        Case Else
            ThrowError errorNumber, methodName

    End Select

End Sub

Private Sub ThrowError(ByVal errorNumber As ReversibleHashMapErrors, Optional ByVal sourceMethod As String = vbNullString)

    Select Case errorNumber
        Case ReversibleHashMapErrors.MismatchedLength
            Err.Description = MISMATCH_LENGTH_ERROR

        Case ReversibleHashMapErrors.SetsNotIterable
            Err.Description = SETS_NOT_ITERABLE_ERROR

        Case ReversibleHashMapErrors.KeyDoesNotExist
            Err.Description = "Key " & VALUE_DOES_NOT_EXIST_ERROR & "Keys"

        Case ReversibleHashMapErrors.ItemDoesNotExist
            Err.Description = "Item " & VALUE_DOES_NOT_EXIST_ERROR & "Items"

    End Select

    Err.Raise errorNumber, Source:=IIf(sourceMethod <> vbNullString, TypeName(Me) & "." & sourceMethod, TypeName(Me))

End Sub

Private Function NumberOfArrayDimensions(variantArray As Variant) As Integer

    Dim index As Long, upperBound As Long

        On Error Resume Next
        Err.Clear
        Do
            index = index + 1
            upperBound = UBound(variantArray, index)
        Loop Until Err.Number <> 0

    NumberOfArrayDimensions = index - 1

End Function

Private Function IsMultiColumnArray(variantArray As Variant) As Boolean

    On Error Resume Next
    Err.Clear

    Dim value As Variant
    value = variantArray(LBound(variantArray), 2)

    IsMultiColumnArray = (Err.Number = 0)

End Function

Tests:

Option Explicit

Sub TestNonDefaultInstance()

    'this will throw an error
    Dim test As ReversibleHashMapFactory
    Set test = New ReversibleHashMapFactory

End Sub

Sub TestUsingFactory()

    Dim map As ReversibleHashMap
    Set map = ReversibleHashMapFactory.Create([A1:A3].value, [B1:B3].value)

    Debug.Assert map.GetItem([A2].value) = [B2].value
    Debug.Assert map.GetKey([B3].value) = [A3].value

    Debug.Print map.Count

    'Uncomment to test error
'    Debug.Print map.GetKey([A1].value)
'    Debug.Print map.GetItem([B2].value)

    If Not map.KeyExists([A1].value) Then Debug.Print map.GetKey([A1].value)
    If Not map.ItemExists([B2].value) Then Debug.Print map.GetItem([B2].value)

    Debug.Assert map.KeyExists("TestKey")
    Debug.Assert map.ItemExists("TestItem")

    Debug.Assert map.PairExists("TestKey", "TestItem")

    If Not map.PairExists("TestKey", "TestItem") Then map.MapPair "TestKey", "TestItem"

End Sub

Sub TestUsingClassDirectly()

    Dim map As ReversibleHashMap
    Set map = New ReversibleHashMap

    map.MapPairs [A1:A3].value, [B1:B3].value

    Dim values As Variant
    values = [A1:B5].value

    Dim i As Long
    For i = 1 To 5
        If Not map.PairExists(values(i, 1), values(i, 2)) Then
            map.MapPair values(i, 1), values(i, 2)
        End If
    Next i


    Debug.Assert map.GetItem([A2].value) = [B2].value
    Debug.Assert map.GetKey([B3].value) = [A3].value

    Debug.Assert map.KeyExists([A2].value)
    Debug.Assert map.ItemExists([B2].value)

    If Not map.PairExists("TestKey", "TestItem") Then map.MapPair "TestKey", "TestItem"

End Sub
| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.