But is it relevant/mandatory to retrieve the Keys and the Values in the order they were entered ? What counts is that both the Keys array and the Values array are in sync, right ? (granted there has been no modification to the Dictionary in-between).
You ask an excellent question, and I was trying to emulate the native Dictionary in that respect. I also feel like I’ve taken advantage of this in the past.
If I change it now, I’d have to redesign most of it starting with introducing a Pair class. The bin would change to an array of Pair, and each Pair would hold an array of keys on the left and an array of values on the right. To grab an array of Keys or Values, I’d have to cycle through the entire bin looking for non-nil values. As I find them, I’d add the Keys/Values from the contents to the array.
I’ll have to think about whether it’s worth it. The scheme seems like it would be more memory-efficient, but ultimately slower.
I’m not sure the native Dictionary ensures that it returns the Keys or Values in the order they were entered. I don’t see that from the documentation (or perhaps this was mentioned by a Xojo developer in a thread or a blog ?). What it ensures is to have the Keys and Values in-sync (as long as the Dictionary is not modified of course).
Regarding cycling through the entire bin looking for non-nil values, you could create a helper array were you append the indices of the bin occupied slots. This way you would just have to scan this helper array instead of the entire bin.
Regarding the bin change I would have thought to keep it as an array of array, as before, but instead of storing indices in the secondary array I would have stored straight Pairs of Keys/Values. I understand you would then have to grab the Keys or Values one by one to reconstitute an array, but I’m thinking more about the Value()/Lookup() efficiency than the Keys()/Values() efficiency, I have to admit.
On a second thought, perhaps it would be more efficient to let Instr to find the Key in the array, with your first idea of storing the arrays of Keys and Values on Left/Right of a Pair, instead of having an array of Pairs.
I did a small (very small) test to see if the Keys maintain their order of entry in the native Dictionary even after removal of previous keys, and they do. But I can’t find the documentation on this either, so perhaps that’s not always true or subject to change. As you say, it’s probably not that important.
I think my plan would be more efficient for Value()/Lookup() too since I could then leverage IndexOf on the key array within the Pair.
binIndex = key.Hash mod ( zBin.Ubound + 1 )
dim p As Pair = zBin( binIndex )
if p <> nil then
dim k() As Variant = p.Left
dim keyIndex as Integer = k.IndexOf( key )
if keyIndex <> -1 then // found it
end if
end ifI agree, yes. (I meant IndexOf indeed, not Instr…)
Now I have to think about whether I really want to refactor this. 
One advantage is that a nil key would be acceptable. Since my scheme changes a key to nil to mark it “removed”, that’s currently not permitted.
In the meantime, here is the latest version, including unit tests. This adds a Constructor that lets you define the BinCount (you can’t change the existing BinCount as you can with the native Dictionary), and trims the Key/Value arrays if possible when keys are removed.
Class Dictionary_MTC
Const Version = 1.1
Private Const kDefaultBinUbound = 4999
Private zKeys() As Variant
Private zValues() As Variant
Private zBin() As Variant
Private zRemovedCount As Integer
Private zLastBinIndex As Integer
Private zBinUbound As Integer
Private Function pGetKeyIndex ( key As Variant ) As Integer
if key = nil then return -1
zLastBinIndex = key.Hash mod ( zBin.Ubound + 1 )
if zBin( zLastBinIndex ) is nil then
return -1
end if
dim arr() As Integer = zBin( zLastBinIndex )
dim i as Integer
for i = 0 to arr.Ubound
dim keyIndex as Integer
keyIndex = arr( i )
if zKeys( keyIndex ) = key then
return keyIndex
end if
next i
return -1
End Function
Private Sub pRaiseException()
// Just raise a NilObjectException for now
dim arr() as Integer
arr = nil
dim i as Integer = arr.IndexOf( 1 )
End Sub
Sub Value ( key As Variant, Assigns value As Variant )
if key = nil then pRaiseException()
dim keyIndex as Integer = pGetKeyIndex( key )
if keyIndex <> -1 then
zValues( keyIndex ) = value // Overwrite the existing value
else
zKeys.Append key
zValues.Append value
dim binIndex as Integer = zLastBinIndex
dim arr() as Integer
if zBin( binIndex ) <> nil then
arr = zBin( binIndex )
end if
arr.Append zKeys.Ubound
zBin( binIndex ) = arr
end if
End Sub
Sub Constructor ( binCount As Integer = 0 )
if binCount < 1 then
zBinUbound = kDefaultBinUbound
else
zBinUbound = binCount - 1
end if
redim zBin( zBinUbound )
End Sub
Function Value ( key As Variant ) As Variant
if key = nil then pRaiseException()
dim keyIndex as Integer = pGetKeyIndex( key )
if keyIndex = -1 then
pRaiseException()
return nil
end if
return zValues( keyIndex )
End Function
Function Lookup ( key As Variant, default As Variant ) As Variant
if key = nil then pRaiseException()
dim keyIndex as Integer = pGetKeyIndex( key )
if keyIndex = -1 then
return default
else
return zValues( keyIndex )
end if
End Function
Function HasKey ( key As Variant ) As Boolean
if key = nil then pRaiseException()
return pGetKeyIndex( key ) <> -1
End Function
Function Count() As Integer
return zKeys.Ubound + 1 - zRemovedCount
End Function
Function Keys() As Variant()
dim k() as Variant
dim i as Integer
for i = 0 to zKeys.Ubound
dim thisKey as Variant = zKeys( i )
if thisKey <> nil then
k.Append thisKey
end if
next i
return k
End Function
Function Values() As Variant()
dim v() as Variant
dim i as Integer
for i = 0 to zValues.Ubound
if zKeys( i ) <> nil then
v.Append zValues( i )
end if
next i
return v
End Function
Sub Remove ( key As Variant )
if key = nil then pRaiseException()
dim keyIndex as Integer = pGetKeyIndex( key )
if keyIndex = -1 then pRaiseException()
zKeys( keyIndex ) = nil
zValues( keyIndex ) = nil
zRemovedCount = zRemovedCount + 1
dim arr() as Integer = zBin( zLastBinIndex )
arr.Remove arr.IndexOf( keyIndex )
zBin( zLastBinIndex ) = arr
// Trim the arrays
dim lastGoodIndex as Integer = zKeys.Ubound
while lastGoodIndex <> -1 and zKeys( lastGoodIndex ) is nil
lastGoodIndex = lastGoodIndex - 1
zRemovedCount = zRemovedCount - 1
wend
if zKeys.Ubound <> lastGoodIndex then
redim zKeys( lastGoodIndex )
redim zValues( lastGoodIndex )
end if
End Sub
Function BinCount() As Integer
return zBinUbound + 1
End Function
Sub Clear()
redim zKeys( -1 )
redim zValues( -1 )
redim zBin( -1 )
redim zBin( zBinUbound )
zRemovedCount = 0
End Sub
End Class
// Unit Tests
Function PrintIfNot ( condition As Boolean, msg As String ) As Boolean
dim printIt as Boolean = not condition
if printIt then
print msg
end if
return printIt
End Function
// TEST CODE
dim failed as boolean
dim d as Dictionary_MTC
d = new Dictionary_MTC
d.Value( 1 ) = 2
failed = PrintIfNot( d.Value( 1 ) = 2, "The value 2 was not stored in key1" ) or failed
d.Value( 1 ) = 3
failed = PrintIfNot( d.Value( 1 ) = 3, "The value for key 1 was not overwritten" ) or failed
failed = PrintIfNot( d.Lookup( 1, 88 ) = 3, "Lookup of existing key failed" ) or failed
failed = PrintIfNot( d.Lookup( 2, 99 ) = 99, "Loojup of unknown key failed" ) or failed
failed = PrintIfNot( d.HasKey( 1 ), "HasKey failed with existing key" ) or failed
failed = PrintIfNot( not d.HasKey( 2 ), "HasKey failed with unknown key" ) or failed
failed = PrintIfNot( d.Count = 1, "Count should be 1, instead is " + Str( d.Count ) ) or failed
d.Remove( 1 )
failed = PrintIfNot( d.Count = 0, "Remove has failed. Count is " + Str( d.Count ) ) or failed
try
print d.Value( 1 ) // Exception
print "An exception should have been generated looking up an unknown key"
failed = true
catch
// What we expect so keep going
end try
dim k() as Variant
k = d.Keys
failed = PrintIfNot( k.Ubound = -1, "Got back " + Str( k.Ubound ) + " Keys even though the Dictionary should be empty" ) or failed
d.Value( "s" ) = 1
d.Value( "S" ) = 2
failed = PrintIfNot( d.Value( "s" ) = 2 and d.Value( "S" ) = 2, "Case-insensitivity seems to have been lost" ) or failed
dim index as Integer
dim startTime, endTime as Double
const kLoops = 10000
d = new Dictionary_MTC( kLoops * 2 )
startTime = microseconds
for index = 1 to kLoops
d.Value( Str( index ) ) = index
next index
endTime = microseconds
print "Storage took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
dim retrieved as Variant
startTime = microseconds
for index = 1 to kLoops
retrieved = d.Value( Str( index ) )
if retrieved <> index then
failed = true
print "Retrival failed"
exit
end if
next index
endTime = microseconds
print "Retrieval took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
if FALSE then
// Compare to array
dim keyArr( kLoops ) as String
dim valueArr( kLoops ) As Integer
for index = 1 to kLoops
keyArr( index ) = Str( index )
valueArr( index ) = index
next index
startTime = microseconds
for index = 1 to kLoops
retrieved = valueArr( keyArr.IndexOf( Str( index ) ) )
if retrieved <> index then
print "Array lookup failed?"
exit
end if
next index
endTime = microseconds
print "Array lookup took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
end if
if not failed then
print "ALL TESTS HAVE PASSED!"
end ifLike you found in the documentation, Dictionary explicitly does not guarantee that items in the Keys/Values arrays are returned in any specific order.
[quote=82935:@Guy Rabiller]Paul, forgive me, I don’t want to sound harsh here but your Dictionary implementation is inefficient.
[/quote]
Yeh. I guess I used my usual ploy of:
- Get it working.
- Make it work efficiently.
but never got around to step 2.
In my application, efficiency is not paramount.
I reworked it based on this conversation. I created a private class called DictionaryBinEntry with two properties, Keys() As Variant and Values() As Variant. The zBin array is now an array of that class. Everything else is worked out around that. This turns out to be a little faster than the first implementation, although it’s still much slower than the native Dictionary.
Ironically, I couldn’t use IndexOf because Variant.IndexOf considers case (case-insensitivity is lost).
Module MTCUtils
Private Class DictionaryBinEntry
Dim Keys() As Variant
Dim Values() As Variant
End Class
Class Dictionary_MTC
Const Version = 2.0
Private Const kDefaultBinUbound = 4999
Private zBin() As DictionaryBinEntry
Private zBinUbound As Integer
Private zCount As Integer
// Private Methods
Private Function pBinIndex ( key As Variant ) as Integer
return key.Hash mod ( zBin.Ubound + 1 )
End Function
Private Function pBinEntry ( key As Variant, ByRef binIndex As Integer ) As DictionaryBinEntry
binIndex = pBinIndex( key )
return zBin( binIndex )
End Function
Private Function pBinEntry ( key As Variant ) As DictionaryBinEntry
dim binIndex as Integer = pBinIndex( key )
return zBin( binIndex )
End Function
Private Function pIndexOf ( variantArr() As Variant, value As Variant ) As Integer
// Need this because native IndexOf is case-sensitive with Variants
dim r as Integer = -1
dim i as integer
for i = 0 to variantArr.Ubound
if variantArr( i ) = value then
r = i
exit
end if
next i
return r
End Function
// Constructor
Sub Constructor ( binCount As Integer = 0 )
if binCount < 1 then
zBinUbound = kDefaultBinUbound
else
zBinUbound = binCount - 1
end if
redim zBin( zBinUbound )
End Sub
// Value
Function Value ( key As Variant ) As Variant
dim binEntry as DictionaryBinEntry = pBinEntry( key )
dim keyIndex as Integer = pIndexOf( binEntry.Keys, key )
return binEntry.Values( keyIndex )
End Function
Sub Value ( key As Variant, Assigns value As Variant )
dim binIndex as Integer
dim binEntry as DictionaryBinEntry = pBinEntry( key, binIndex )
dim keyIndex as Integer
if binEntry is nil then
binEntry = new DictionaryBinEntry
keyIndex = -1
else
keyIndex = pIndexOf( binEntry.Keys, key )
end if
if keyIndex = -1 then // New entry
binEntry.Keys.Append key
binEntry.Values.Append value
zCount = zCount + 1
else
binEntry.Values( keyIndex ) = value
end if
zBin( binIndex ) = binEntry
End Sub
// Lookup
Function Lookup ( key As Variant, default As Variant ) As Variant
dim binEntry as DictionaryBinEntry = pBinEntry( key )
if binEntry is nil or binEntry.Keys.Ubound = -1 then return default
dim keyIndex as Integer = pIndexOf( binEntry.Keys, key )
if keyIndex = -1 then
return default
else
return binEntry.Values( keyIndex )
end if
End Function
// HasKey
Function HasKey ( key As Variant ) As Boolean
dim binEntry as DictionaryBinEntry = pBinEntry( key )
if binEntry is nil or binEntry.Keys.Ubound = -1 then return false
return pIndexOf( binEntry.Keys, key ) <> -1
End Function
// Remove
Sub Remove ( key As Variant )
dim binIndex as Integer
dim binEntry as DictionaryBinEntry = pBinEntry( key, binIndex )
dim keyIndex as integer = pIndexOf( binEntry.Keys, key )
binEntry.Keys.Remove keyIndex
binEntry.Values.Remove keyIndex
zCount = zCount - 1
End Sub
// Keys
Function Keys() As Variant
dim k() as Variant
dim binEntry as DictionaryBinEntry
dim binIndex as Integer
for binIndex = 0 to zBin.Ubound
binEntry = zBin( binIndex )
if binEntry <> nil then
dim allKeys() as Variant = binEntry.Keys
dim keyIndex as Integer
for keyIndex = 0 to allKeys.Ubound
k.Append allKeys( keyIndex )
next keyIndex
end if
next binIndex
return k()
End Function
// Values
Function Values() As Variant
dim v() as Variant
dim binEntry as DictionaryBinEntry
dim binIndex as Integer
for binIndex = 0 to zBin.Ubound
binEntry = zBin( binIndex )
if binEntry <> nil then
dim allKeys() as Variant = binEntry.Values
dim valueIndex as Integer
for valueIndex = 0 to allKeys.Ubound
v.Append allKeys( valueIndex )
next valueIndex
end if
next binIndex
return v()
End Function
// Count
Function Count() As Integer
return zCount
End Function
// Clear
Sub Clear()
redim zBin( -1 )
redim zBin( zBinUbound )
zCount = 0
End Sub
End Class
End Module
// Unit Tests
Function PrintIfNot ( condition As Boolean, msg As String ) As Boolean
dim printIt as Boolean = not condition
if printIt then
print msg
end if
return printIt
End Function
// TEST CODE
dim failed as boolean
dim d as Dictionary_MTC
d = new Dictionary_MTC
d.Value( 1 ) = 2
failed = PrintIfNot( d.Value( 1 ) = 2, "The value 2 was not stored in key1" ) or failed
d.Value( 1 ) = 3
failed = PrintIfNot( d.Value( 1 ) = 3, "The value for key 1 was not overwritten" ) or failed
failed = PrintIfNot( d.Lookup( 1, 88 ) = 3, "Lookup of existing key failed" ) or failed
failed = PrintIfNot( d.Lookup( 2, 99 ) = 99, "Loojup of unknown key failed" ) or failed
failed = PrintIfNot( d.HasKey( 1 ), "HasKey failed with existing key" ) or failed
failed = PrintIfNot( not d.HasKey( 2 ), "HasKey failed with unknown key" ) or failed
failed = PrintIfNot( d.Count = 1, "Count should be 1, instead is " + Str( d.Count ) ) or failed
d.Remove( 1 )
failed = PrintIfNot( d.Count = 0, "Remove has failed. Count is " + Str( d.Count ) ) or failed
try
print d.Value( 1 ) // Exception
print "An exception should have been generated looking up an unknown key"
failed = true
catch
// What we expect so keep going
end try
dim k() as Variant
k = d.Keys
failed = PrintIfNot( k.Ubound = -1, "Got back " + Str( k.Ubound ) + " Keys even though the Dictionary should be empty" ) or failed
d.Value( "s" ) = 1
d.Value( "S" ) = 2
failed = PrintIfNot( d.Value( "s" ) = 2 and d.Value( "S" ) = 2, "Case-insensitivity seems to have been lost" ) or failed
failed = PrintIfNot( d.Count = 1, "Count should be 1 but is " + Str( d.Count ) ) or failed
d.Value( "f" ) = 3
d.Value( "e" ) = 4
failed = PrintIfNot( d.Count = 3, "Count should be 3 but is " + Str( d.Count ) ) or failed
k = d.Keys
failed = PrintIfNot( k.Ubound = 2, "Ubound for Keys should be 2 but is " + Str( k.Ubound ) ) or failed
dim result as string
dim index as Integer
for index = 0 to k.Ubound
result = result + k( index )
next index
failed = PrintIfNot( result = "efs", "Result of Keys doesn't match: " + result ) or failed
dim v() as Variant
v = d.Values
failed = PrintIfNot( v.Ubound = 2, "UBound for Values should be 2 but is " + Str( v.Ubound ) ) or failed
result = ""
for index = 0 to v.Ubound
result = result + v( index )
next index
failed = PrintIfNot( result = "432", "Result of Values doesn't match: " + result ) or failed
d.Remove( "E" )
failed = PrintIfNot( d.Count = 2, "Count should be 2 but is " + Str( d.Count ) ) or failed
dim startTime, endTime as Double
const kLoops = 10000
d = new Dictionary_MTC( kLoops * 2 )
startTime = microseconds
for index = 1 to kLoops
d.Value( Str( index ) ) = index
next index
endTime = microseconds
print "Storage took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
dim retrieved as Variant
startTime = microseconds
for index = 1 to kLoops
retrieved = d.Value( Str( index ) )
if retrieved <> index then
failed = true
print "Retrieval failed"
exit
end if
next index
endTime = microseconds
print "Retrieval took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
if FALSE then
// Compare to array
dim keyArr( kLoops ) as String
dim valueArr( kLoops ) As Integer
for index = 1 to kLoops
keyArr( index ) = Str( index )
valueArr( index ) = index
next index
startTime = microseconds
for index = 1 to kLoops
retrieved = valueArr( keyArr.IndexOf( Str( index ) ) )
if retrieved <> index then
print "Array lookup failed?"
exit
end if
next index
endTime = microseconds
print "Array lookup took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
end if
if not failed then
print "ALL TESTS HAVE PASSED!"
end ifI was thinking about another strategy, If I have the time I may test it as well:
The idea would be to keep the original Arrays of Arrays, but with more Arrays, and ultimately directly storing a Key/Value Pair, without the need for IndexOf or for scanning any Array, just using hash each time.
- As before, compute a hash to get an index in the main bin array.
- Check if, at that index, you have an Array or a Pair or Nil.
2a) If Nil, just store the Pair.
2b) If Pair, you have collision, then create an Array. and go to step 2c)
2c) If Array, then use another Hash computation to store the Pair in that Array. - Whenever there is a collision (even at step 2c), continue to create Arrays and use Hash computation again to store Pairs.
bin : (a,b,c,…)
a: Nil or
a: Pair(Key/Value) or
a: (aa,ba,ca, …)
aa: Nil or
aa: Pair(Key/Value) or
aa: (aaa,baa,caa,…) or
etc…
This way you never scan an Array, you go directly to a slot through Hash values and Arrays of Arrays of Arrays of … until you get the Pair(Key/Value).
This may be a bit less Memory efficient as you have to create empty Arrays at each ‘level’ (although the length of the Array can diminish at each level) but this may leads to substantial gain in speed, well in theory…
This would not help in gathering the Keys and Values Arrays though, but personally I’m more concerned about the Value/Lookup performance.
(In fact, I’m thinking that storing Keys and Values could be done by the user of the Dictionary using Arrays outside of the Dictionary, which would discharge the Dictionary of a lot of useless troubles and allows it to focus on its main purpose: fast Key lookup.)
I’d be interested to know the results of your tests.
In the meantime, I added to reporting features to my version to aid in analysis, Collision and MostCollisions.
In my test code where I store 10,000 items, if I don’t change the default bin count of 5,000 (Ubound 4999), I get 5090 collisions, but the most collision in any one bin is 5 (meaning that 6 items are stored in that bin).
If I change the bin count to 20,000 (twice the number of items stored), collisions drop to 2,694, and the most in any one bin is 3. If I use 20,001 (an odd number), collisions drop to 1,509 and the most is 1. HOWEVER, while increasing the bin count helps over the default, the lookup times are otherwise unaffected.
My fear with your scheme is that all the extra processing and conversions will take more time than actually looking up the values. However, as I said, I’d be curious to know.
Here is the latest version. I made the default bin count an odd number and moved the code that scans variants so it can be available outside the module.
Module MTCUtils
Protected Function VariantIndexOf ( variantArr() As Variant, value As Variant ) As Integer
// Need this because native IndexOf is case-sensitive with Variants
dim i as integer
for i = 0 to variantArr.Ubound
if variantArr( i ) = value then
return i
end if
next i
return -1 // Not found
End Function
Private Class DictionaryBinEntry
Dim Keys() As Variant
Dim Values() As Variant
End Class
Class Dictionary_MTC
Const Version = 2.1
Private Const kDefaultBinUbound = 5000 // Makes Bin Count an odd number
Private zBin() As DictionaryBinEntry
Private zBinUbound As Integer
Private zBinCount As Integer
Private zCount As Integer
// Private Methods
Private Function pBinIndex ( key As Variant ) as Integer
return key.Hash mod zBinCount
End Function
Private Function pBinEntry ( key As Variant, ByRef binIndex As Integer ) As DictionaryBinEntry
binIndex = pBinIndex( key )
return zBin( binIndex )
End Function
Private Function pBinEntry ( key As Variant ) As DictionaryBinEntry
dim binIndex as Integer = pBinIndex( key )
return zBin( binIndex )
End Function
// Constructor
Sub Constructor ( binCount As Integer = 0 )
if binCount < 1 then
zBinUbound = kDefaultBinUbound
else
zBinUbound = binCount - 1
end if
redim zBin( zBinUbound )
zBinCount = zBinUbound + 1
End Sub
// Value
Function Value ( key As Variant ) As Variant
dim binEntry as DictionaryBinEntry = pBinEntry( key )
dim keyIndex as Integer = VariantIndexOf( binEntry.Keys, key )
return binEntry.Values( keyIndex )
End Function
Sub Value ( key As Variant, Assigns value As Variant )
dim binIndex as Integer
dim binEntry as DictionaryBinEntry = pBinEntry( key, binIndex )
dim keyIndex as Integer
if binEntry is nil then
binEntry = new DictionaryBinEntry
keyIndex = -1
else
keyIndex = VariantIndexOf( binEntry.Keys, key )
end if
if keyIndex = -1 then // New entry
binEntry.Keys.Append key
binEntry.Values.Append value
zCount = zCount + 1
else
binEntry.Values( keyIndex ) = value
end if
zBin( binIndex ) = binEntry
End Sub
// Lookup
Function Lookup ( key As Variant, default As Variant ) As Variant
dim binEntry as DictionaryBinEntry = pBinEntry( key )
if binEntry is nil or binEntry.Keys.Ubound = -1 then return default
dim keyIndex as Integer = VariantIndexOf( binEntry.Keys, key )
if keyIndex = -1 then
return default
else
return binEntry.Values( keyIndex )
end if
End Function
// HasKey
Function HasKey ( key As Variant ) As Boolean
dim binEntry as DictionaryBinEntry = pBinEntry( key )
if binEntry is nil or binEntry.Keys.Ubound = -1 then return false
return VariantIndexOf( binEntry.Keys, key ) <> -1
End Function
// Remove
Sub Remove ( key As Variant )
dim binIndex as Integer
dim binEntry as DictionaryBinEntry = pBinEntry( key, binIndex )
dim keyIndex as integer = VariantIndexOf( binEntry.Keys, key )
binEntry.Keys.Remove keyIndex
binEntry.Values.Remove keyIndex
zCount = zCount - 1
End Sub
// Keys
Function Keys() As Variant
dim k() as Variant
dim binEntry as DictionaryBinEntry
dim binIndex as Integer
for binIndex = 0 to zBin.Ubound
binEntry = zBin( binIndex )
if binEntry <> nil then
dim allKeys() as Variant = binEntry.Keys
dim keyIndex as Integer
for keyIndex = 0 to allKeys.Ubound
k.Append allKeys( keyIndex )
next keyIndex
end if
next binIndex
return k()
End Function
// Values
Function Values() As Variant
dim v() as Variant
dim binEntry as DictionaryBinEntry
dim binIndex as Integer
for binIndex = 0 to zBin.Ubound
binEntry = zBin( binIndex )
if binEntry <> nil then
dim allKeys() as Variant = binEntry.Values
dim valueIndex as Integer
for valueIndex = 0 to allKeys.Ubound
v.Append allKeys( valueIndex )
next valueIndex
end if
next binIndex
return v()
End Function
// Count
Function Count() As Integer
return zCount
End Function
// Clear
Sub Clear()
redim zBin( -1 )
redim zBin( zBinUbound )
zCount = 0
End Sub
// Reporting
// Collisions (report how many collisions have occurred)
Function Collisions() As Integer
dim r as Integer
dim binEntry as DictionaryBinEntry
for each binEntry in zBin
if binEntry <> nil then
dim cnt as Integer = binEntry.Keys.Ubound
if cnt > 0 then r = r + cnt
end if
next binEntry
return r
End Function
Function MostCollisions() As Integer
dim r as Integer
dim binEntry as DictionaryBinEntry
for each binEntry in zBin
if binEntry <> nil then
dim cnt as Integer = binEntry.Keys.Ubound
if cnt > r then r = cnt
end if
next binEntry
return r
End Function
End Class
End Module
// ----------------- END MODULE -----------------------Since it’s too long for one post now, here are the unit tests:
// Unit Tests
Function PrintIfNot ( condition As Boolean, msg As String ) As Boolean
dim printIt as Boolean = not condition
if printIt then
print msg
end if
return printIt
End Function
dim failed as boolean
dim d as Dictionary_MTC
d = new Dictionary_MTC
d.Value( 1 ) = 2
failed = PrintIfNot( d.Value( 1 ) = 2, "The value 2 was not stored in key1" ) or failed
d.Value( 1 ) = 3
failed = PrintIfNot( d.Value( 1 ) = 3, "The value for key 1 was not overwritten" ) or failed
failed = PrintIfNot( d.Lookup( 1, 88 ) = 3, "Lookup of existing key failed" ) or failed
failed = PrintIfNot( d.Lookup( 2, 99 ) = 99, "Loojup of unknown key failed" ) or failed
failed = PrintIfNot( d.HasKey( 1 ), "HasKey failed with existing key" ) or failed
failed = PrintIfNot( not d.HasKey( 2 ), "HasKey failed with unknown key" ) or failed
failed = PrintIfNot( d.Count = 1, "Count should be 1, instead is " + Str( d.Count ) ) or failed
d.Remove( 1 )
failed = PrintIfNot( d.Count = 0, "Remove has failed. Count is " + Str( d.Count ) ) or failed
try
print d.Value( 1 ) // Exception
print "An exception should have been generated looking up an unknown key"
failed = true
catch
// What we expect so keep going
end try
dim k() as Variant
k = d.Keys
failed = PrintIfNot( k.Ubound = -1, "Got back " + Str( k.Ubound ) + " Keys even though the Dictionary should be empty" ) or failed
d.Value( "s" ) = 1
d.Value( "S" ) = 2
failed = PrintIfNot( d.Value( "s" ) = 2 and d.Value( "S" ) = 2, "Case-insensitivity seems to have been lost" ) or failed
failed = PrintIfNot( d.Count = 1, "Count should be 1 but is " + Str( d.Count ) ) or failed
d.Value( "f" ) = 3
d.Value( "e" ) = 4
failed = PrintIfNot( d.Count = 3, "Count should be 3 but is " + Str( d.Count ) ) or failed
k = d.Keys
failed = PrintIfNot( k.Ubound = 2, "Ubound for Keys should be 2 but is " + Str( k.Ubound ) ) or failed
dim result as string
dim index as Integer
for index = 0 to k.Ubound
result = result + k( index )
next index
failed = PrintIfNot( result = "efs", "Result of Keys doesn't match: " + result ) or failed
dim v() as Variant
v = d.Values
failed = PrintIfNot( v.Ubound = 2, "UBound for Values should be 2 but is " + Str( v.Ubound ) ) or failed
result = ""
for index = 0 to v.Ubound
result = result + v( index )
next index
failed = PrintIfNot( result = "432", "Result of Values doesn't match: " + result ) or failed
d.Remove( "E" )
failed = PrintIfNot( d.Count = 2, "Count should be 2 but is " + Str( d.Count ) ) or failed
dim startTime, endTime as Double
const kLoops = 10000
'd = new Dictionary_MTC( kLoops * 2 ) // Twice kLoops
d = new Dictionary_MTC( kLoops * 2 + 1 ) // Odd number
'd = new Dictionary_MTC
'd = new Dictionary_MTC( 20011 ) // Prime number
startTime = microseconds
for index = 1 to kLoops
d.Value( Str( index ) ) = index
next index
endTime = microseconds
print "Storage took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
dim retrieved as Variant
startTime = microseconds
for index = 1 to kLoops
retrieved = d.Value( Str( index ) )
if retrieved <> index then
failed = true
print "Retrieval failed"
exit
end if
next index
endTime = microseconds
print "Retrieval took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
print "Collisions: " + Str( d.Collisions )
print "Most Collisions: " + Str( d.MostCollisions )
if FALSE then
// Compare to array
dim keyArr( kLoops ) as String
dim valueArr( kLoops ) As Integer
for index = 1 to kLoops
keyArr( index ) = Str( index )
valueArr( index ) = index
next index
startTime = microseconds
for index = 1 to kLoops
retrieved = valueArr( keyArr.IndexOf( Str( index ) ) )
if retrieved <> index then
print "Array lookup failed?"
exit
end if
next index
endTime = microseconds
print "Array lookup took " + format( ( endTime - startTime ) / 1000, "#,0.000") + " milliseconds"
end if
if not failed then
print "ALL TESTS HAVE PASSED!"
end ifThis is a great class. Thanks!
Is there a way to make your Dictionary case-SENSITIVE?
You could implement dictionaries indirectly via the XojoScript context object. The dictionary methods would
be implemented as methods within the context object and some type of ref/id would be used to reference the dictionary in the script. The dictionaries would be stored in a property of the context object.
eg:
A method called CreateDictionary in the context object would create a new dictionary, store it in a class property (possibly itself a dictionary) and return a ref/id back to the script.
A method called DictionaryAdd in the context object would accept the ref/id among with the key and value. The method would look up the dictionary in its storage and then add the value to the dictionary.
The XojoScript could then do:
Dim ref as Integer
ref = CreateDictionary
DictionaryAdd(ref, thekey, thevalue)
We have successfully used this method to provide access to FolderItems and XML objects within XojoScripts with very little effort.
I think there’s a bug in this function:
Private Function pBinIndex ( key As Variant ) as Integer
return key.Hash mod zBinCount
End Function
It’s possible for key.Hash to be a negative index which will cause a subsequent OutOfBounds exception. I think the following change fixes it:
Private Function pBinIndex ( key As Variant ) as Integer
return Abs(key.Hash mod zBinCount)
End Function
On a related note @Kem Tekinay: Is this a better implementation of a Dictionary for Xojoscript (another implementation of yours)? https://forum.xojo.com/23970-xojoscript-dictionary/0. I see it uses a custom Pair class.
Wow, I guess I should pay attention to my own posts. As the other is “newer”, and included with XsEdit, I’d go with that, but it may suffer from the same bug.
I’ve tried benchmarking the two different dictionary implementations and I think this one marginally edges out the Pair based one in speed (for what it’s worth). Probably 10-20% faster.