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