Sort сначала ArrayList, а затем используйте BinarySearch.Это должно дать даже лучшую производительность, чем подход «Словарь», поскольку вам не нужно создавать другую коллекцию или зацикливать существующие полностью для поиска элементов.
Конечно, это далеко не элегантный и читаемый код, но он быстро (~ 2 с для 10-миллиметровых поисков).
Dim letters = New ArrayList() From {"A", "B", "C", "D", "A", "C", "E", "cC", "C", "E", "A", "c", "C", "F", "C"}
letters.Sort() ' just needed once and only if it's not already sorted
Dim lookupItem = "C"
Dim itemCount = 0 ' correct result: 5 (case-sensitive)
Dim index = letters.BinarySearch(lookupItem)
If index > -1 Then
Dim nextIndex = index
While letters(nextIndex).Equals(lookupItem)
itemCount += 1
nextIndex += 1
End While
If index > 0 Then
' look into the other direction since BinarySearch
' does not necessarily return the first index
' in this example index is 6 instead of 5
Dim prevIndex = index - 1
While letters(prevIndex).Equals(lookupItem)
itemCount += 1
prevIndex -= 1
End While
End If
End If
Обратите внимание, что тип вашего value должен реализовывать IComparable или вы определяете пользовательский Comparer, который вы можете передать BinarySearch.
Кстати, вместо ArrayList вы должны использовать родственные списки с сильными связями, например List(Of String).
Редактировать : потому что яуже упомянутый обобщенный Lists, я покажу вам другой подход, использующий Lists(Of T), уже обернутый в удобный метод расширения:
Public Module ListExtensions
<Runtime.CompilerServices.Extension()> _
Public Function ItemCount(Of T)(ByVal sortedList As List(Of T), item As T) As Int32
Dim count = 0
Dim index = sortedList.BinarySearch(item)
Dim nextIndex = index
If index > -1 Then
While nextIndex < sortedList.Count AndAlso sortedList(nextIndex).Equals(item)
count += 1
nextIndex += 1
End While
If index > 0 Then
Dim prevIndex = index - 1
While prevIndex > 0 AndAlso sortedList(prevIndex).Equals(item)
count += 1
prevIndex -= 1
End While
End If
End If
Return count
End Function
End Module
Теперь вы можете везде получить itemcount любого объекта в любом виде списка.например, List(Of String) и List(Of Integer), включая несколько измерений:
Const chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Dim rnd As New Random()
Dim letters = Enumerable.Range(1, 100000).Select(Function(i) chars(rnd.Next(0, chars.Length)).ToString).ToList
Dim letterTime = New Stopwatch
letterTime.Start()
letters.Sort()
For i = 1 To 100000
Dim count = letters.ItemCount("C")
Next
letterTime.Stop()
Dim numbers = Enumerable.Range(1, 100000).Select(Function(i) rnd.Next(100000)).ToList()
Dim numberTime = New Stopwatch
numberTime.Start()
numbers.Sort()
For i = 1 To 100000
Dim count = numbers.ItemCount(4711)
Next
numberTime.Stop()
' measure the LINQ Where-Extension
Dim letterTimeWhere = New Stopwatch
letterTimeWhere.Start()
For i = 1 To 100000
Dim count = letters.Where(Function(str) str.Equals("C")).Count()
Next
letterTimeWhere.Stop()
Dim numberTimeWhere = New Stopwatch
numberTimeWhere.Start()
For i = 1 To 100000
Dim count = numbers.Where(Function(int) int = 4711).Count()
Next
numberTimeWhere.Stop()
Результат поиска 100000 строк / целых чисел в списках с 100000 элементов.
Dim time = String.Format("String(Binary): {0} Numbers(Binary): {1} String(LINQ): {2} Numbers(LINQ): {3}", letterTime.Elapsed.ToString, numberTime.Elapsed.ToString, letterTimeWhere.Elapsed.ToString, numberTimeWhere.Elapsed.ToString)
' String(Binary): 00:00:05.2602861 Numbers(Binary): 00:00:00.0350816
' String(LINQ) : 00:04:56.8772996 Numbers(LINQ) : 00:01:43.2139190
' => Binary 55 x faster => Binary 2950 x faster
Примечание : Сравнение LINQ, безусловно, несправедливо, поскольку Where необходимо зациклить каждый элемент, а BinarySearch может оптимизировать поиск .Просто ради полноты.
Кстати, @JaredPars Dictionary намного быстрее, когда в списке много дубликатов (следовательно, словарь имеет небольшие размеры, как в образце букв.
String(Dict) : 00:00:00.0224329 Numbers(Dict): 00:00:00.0216544
Я признаю поражение ;)
Вот его словарь в качестве расширения:
<Runtime.CompilerServices.Extension()> _
Public Function ToCountLookup(Of T)(ByVal list As List(Of T)) As Dictionary(Of T, Int32)
Dim table As New Dictionary(Of T, Integer)
For Each s As T In list
Dim count As Int32 = 0
If table.TryGetValue(s, count) Then
table(s) = count + 1
Else
table(s) = 1
End If
Next
Return table
End Function
И вы можете использовать его таким образом,вам нужно TryGetValue, поскольку Dictionary может не содержать этот ключ:
Dim letterLookuptable = letters.ToCountLookup()
For i = 1 To 100000
Dim count = 0
letterLookuptable.TryGetValue("C", count)
Next
Dim intLookuptable = numbers.ToCountLookup()
For i = 1 To 100000
Dim count = 0
intLookuptable.TryGetValue(4711, count)
Next