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:)

asked Dec 18, 2019 at 10:20
\$\endgroup\$

2 Answers 2

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.

answered Dec 19, 2019 at 1:51
\$\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
answered Dec 19, 2019 at 17:03
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.