VBA Dictionary Trim to N smallest items

N

Nick

I have a dictionary and I am trying to trim it down to the N smallest
items. For example, myDict usually contains around 3500 to 5500 items,
and I only want the smallest 10 (usually). The code I'm using now is :

'// loop, removing largest distance until we're down to the number of
points we want
Do Until myDict.Count = N
maxDist = -1
For Each i In myDict.Keys
If myDict.Item(i) > maxDist Then
maxDist = myDict.Item(i)
mx = i
End If
Next i
myDict.Remove mx
Loop

The problem is that this is super slow; it loops through thousands of
times, and this snippet of code is used thousands of times too. Is
there a faster way to get the smallest N items?
 
J

Jim Cone

'This loads the 5 smallest numbers from a dictionary object
'back into the dictionary.
'--
Sub MakeSmaller()
'Jim Cone - Portland, Oregon USA - Oct 2008
Dim dic As Scripting.Dictionary
Dim N As Long
Dim M As Long
Dim howMany As Long
Dim arr As Variant

Set dic = New Scripting.Dictionary
'Desired size of dictionary
howMany = 5

'Load dictionary with 500 random numbers
Randomize
For N = 1 To 500
M = Int(555555 * Rnd + 5000)
dic.Add N, M
Next

'Store all random numbers from dictionary in variant array.
arr = dic.Items
dic.RemoveAll

'Reload the dictionary with the "howmany" smallest numbers.
For N = 0 To howMany - 1
M = Application.Small(arr, N + 1)
dic.Add N, M
'Used for testing
MsgBox dic.Items(dic.Count - 1)
Next
Set dic = Nothing
End Sub
--
Jim Cone
Portland, Oregon USA


"Nick"
wrote in message
I have a dictionary and I am trying to trim it down to the N smallest
items. For example, myDict usually contains around 3500 to 5500 items,
and I only want the smallest 10 (usually). The code I'm using now is :

'// loop, removing largest distance until we're down to the number of
points we want
Do Until myDict.Count = N
maxDist = -1
For Each i In myDict.Keys
If myDict.Item(i) > maxDist Then
maxDist = myDict.Item(i)
mx = i
End If
Next i
myDict.Remove mx
Loop

The problem is that this is super slow; it loops through thousands of
times, and this snippet of code is used thousands of times too. Is
there a faster way to get the smallest N items?
 
N

Nick

'This loads the 5 smallest numbers from a dictionary object
'back into the dictionary.
'--
Sub MakeSmaller()
'Jim Cone - Portland, Oregon USA - Oct 2008
Dim dic As Scripting.Dictionary
Dim N As Long
Dim M As Long
Dim howMany As Long
Dim arr As Variant

 Set dic = New Scripting.Dictionary
'Desired size of dictionary
 howMany = 5

'Load dictionary with 500 random numbers
 Randomize
 For N = 1 To 500
     M = Int(555555 * Rnd + 5000)
     dic.Add N, M
 Next

'Store all random numbers from dictionary in variant array.
 arr = dic.Items
 dic.RemoveAll

'Reload the dictionary with the "howmany" smallest numbers.
 For N = 0 To howMany - 1
     M = Application.Small(arr, N + 1)
     dic.Add N, M
    'Used for testing
     MsgBox dic.Items(dic.Count - 1)
 Next
 Set dic = Nothing
End Sub


Thanks Jim, but that doesn't totally solve my problem.
For exmaple, say I have a dictionary and I want only the 3 smallest
Key Item
1 9
2 8
3 4
4 2
5 12
6 1
7 7
8 7

Your code would result in:
Key Item
0 1
1 2
2 4

When what I want is
Key Item
6 1
4 2
3 4
 
J

Jim Cone

Your question was: "Is there a faster way to get the smallest N items?"
Since you want both items and keys an approach you could try is...

Lay both the items and keys arrays into adjoining blank columns on a worksheet.
Sort both columns by the items column.
Extract the items and keys from the first N rows.
--
Jim Cone
Portland, Oregon USA



"Nick"
wrote in message
Thanks Jim, but that doesn't totally solve my problem.
For exmaple, say I have a dictionary and I want only the 3 smallest
Key Item
1 9
2 8
3 4
4 2
5 12
6 1
7 7
8 7

Your code would result in:
Key Item
0 1
1 2
2 4

When what I want is
Key Item
6 1
4 2
3 4
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top