Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Быстрая коллекция Добавлено: 08.12.09 01:33  

Автор вопроса:  Winand | Web-сайт: winandfx.narod.ru
Нужно отсортировать коллекцию объектов (объект - класс с String полями, по которым и сортируем)
6500 элементов сортируется секунд за 6-7. Решил ускорить и создал индекс - long массив с номерами. По сути сортируется не сама коллекция, а этот массив. И тут я с удивлением обнаружил, что скорость не изменилась вообще.
Почитав http://www.vbaccelerator.com/home/vb/code/techniques/A_Fast_Index-Based_Object_Collection/article.asp узнал что основная проблема коллекций - медленное чтение (а мне как раз все время приходится обращаться к объектам при сортировке). Но предложенная там альтернатива не подходит, т.к. требует дополнительного TLB файла - вся портабельность убивается.

Так вот. Есть какие-нибудь мысли по этому поводу?

Ответить

  Ответы Всего ответов: 8  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #1
Добавлено: 08.12.09 02:03
При доступе к элементам коллекции по ключу, а не номеру, скорость сортировки становится 1.6 - 2.6 сек (в зависимости от поля, по которому сортирую). Однако как удалять-то элементы) Ключи же нельзя изменять. Неужто придется делать коллекцию освободившихся ключей.. Подумайте об этом, товарищи! и скажите чонить)

Ответить

Номер ответа: 2
Автор ответа:
 Alex



Вопросов: 7
Ответов: 73
 Профиль | | #2 Добавлено: 08.12.09 15:33
Можно использовать альтернативный язык - типа PowserBasic или PureBasic. Там реальная скорость выполнения. Можно создать отдельную хелпер библиотечку, она будет небольшой (при желании ее можно зашить в программу).
Можно еще посмотреть примеры с Windows API, но там достаточно мутная работа с фунциями памяти.

Ответить

Номер ответа: 3
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #3
Добавлено: 08.12.09 19:25
Почему бы не сортировать массив вместо коллекции?

Ответить

Номер ответа: 4
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #4
Добавлено: 08.12.09 22:36
Sharp, так я и делаю. Проблема коллекций в медленном доступе к элементам, а при сортировке часто приходится производить чтение из коллекции.
Alex, у меня повсеместно в программе copymemory (я даже long массив им сдвигаю) и прочая мутная работа с памятью. Вот только я не видел примеров реализации коллекции объектов на API

Ответить

Номер ответа: 5
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #5 Добавлено: 08.12.09 23:22
Сортировка 7 секунд на коллекцию из 6.5К элементов? Непростительно много даже для VB6.

Покажи хотя бы код которым ты пытаешься все это сделать.

Ответить

Номер ответа: 6
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #6
Добавлено: 08.12.09 23:52
Artyom, кажется я справился с ситуацией) ура
7 секунд было при сортировке методом Heap sort, при использовании обращения к элементам коллекции по индексу.
Шаг первый: делаем обращение по ключам, для удобства пишем класс
  1. Option Explicit
  2. Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
  3. Private items As Collection
  4. Private l_items(65535) As Long 'Ìàññèâ èíäåêñîâ
  5. Private ln As Long
  6. Private f_items(65535) As Long 'Ìàññèâ ñâîáîäíûõ èíäåêñîâ
  7. Private fn As Long
  8.  
  9. Private Sub Class_Initialize()
  10.     Dim i As Long
  11.     Set items = New Collection
  12.     For i = 0 To 65535
  13.         f_items(i) = 65535 - i
  14.     Next i
  15.     fn = 65536
  16. End Sub
  17.  
  18. Public Sub Add(obj As Object, Optional ByVal before As Long = -1)
  19.     If ln = 65536 Then Err.Raise 1, "FCollection", "No more space"
  20.     decr fn
  21.     If inBounds(before, 0, ln - 1) Then
  22.         CopyMemory l_items(before + 1), l_items(before), (ln - before) * 4
  23.         l_items(before) = f_items(fn)
  24.         items.Add obj, CStr(l_items(before)), before
  25.     Else
  26.         l_items(ln) = f_items(fn)
  27.         items.Add obj, CStr(l_items(ln))
  28.     End If
  29.     incr ln
  30. End Sub
  31.  
  32. Public Function item(ByVal index As Long) As playItem
  33.     If Not inBounds(index, 0, ln - 1) Then Err.Raise 2, "FCollection", "No such an item"
  34.     Set item = items.item(CStr(l_items(index)))
  35. End Function
  36.  
  37. Public Sub Remove(ByVal index As Long)
  38.     If Not inBounds(index, 0, ln - 1) Then Err.Raise 2, "FCollection", "No such an item"
  39.     f_items(fn) = l_items(index)
  40.     items.Remove CStr(l_items(index))
  41.     If index < ln - 1 Then _
  42.         CopyMemory l_items(index), l_items(index + 1), (ln - (index + 1)) * 4
  43.     decr ln
  44.     incr fn
  45. End Sub
  46.  
  47. Public Property Get Count() As Long
  48.     Count = ln
  49. End Property
  50.  
  51. Public Sub Exchange(ByVal i As Long, ByVal j As Long)
  52.     Dim Temp As Long
  53.     Temp = l_items(i)
  54.     l_items(i) = l_items(j)
  55.     l_items(j) = Temp
  56. End Sub

Скорость увеличивается раза в три!

Шаг второй: ищем сортировку с меньшим числом сравнений ==> меняем Heap sort на Quick sort
  1. Private Sub QuickSort2(ByVal First As Long, ByVal Last As Long)
  2.     Dim Low As Long, High As Long, MidValue As String, MidTrck As String, LowAlbum As String, HighAlbum As String
  3.     Low = First
  4.     High = Last
  5.     MidValue = p_items.item((First + Last) \ 2).album
  6.     MidTrck = FormatTrack(p_items.item((First + Last) \ 2).track)
  7.     Do
  8.         Do
  9.             LowAlbum = p_items.item(Low).album
  10.             If LowAlbum < MidValue Then
  11.                 Low = Low + 1
  12.             ElseIf LowAlbum = MidValue Then
  13.                 If FormatTrack(p_items.item(Low).track) < MidTrck Then _
  14.                     Low = Low + 1 _
  15.                 Else Exit Do
  16.             Else
  17.                 Exit Do
  18.             End If
  19.         Loop
  20.         Do
  21.             HighAlbum = p_items.item(High).album
  22.             If HighAlbum > MidValue Then
  23.                 High = High - 1
  24.             ElseIf HighAlbum = MidValue Then
  25.                 If FormatTrack(p_items.item(High).track) > MidTrck Then _
  26.                     High = High - 1 _
  27.                 Else Exit Do
  28.             Else
  29.                 Exit Do
  30.             End If
  31.         Loop
  32.         
  33.         If Low <= High Then
  34.             p_items.Exchange Low, High
  35.             Low = Low + 1
  36.             High = High - 1
  37.         End If
  38.     Loop While Low <= High
  39.     If First < High Then QuickSort2 First, High
  40.     If Low < Last Then QuickSort2 Low, Last
  41. End Sub
  42.  
  43. Private Function FormatTrack(ByRef trck As String) As String
  44.     Dim p As Long
  45.     If Not b(p, InStr(1, trck, "/")) Then p = InStr(1, trck, "\")
  46.     If p > 1 Then
  47.         FormatTrack = Left$(trck, p - 1)
  48.         FormatTrack = Format$(FormatTrack, "0000")
  49.     Else
  50.         FormatTrack = Format$(trck, "0000")
  51.     End If
  52. End Function

Приведенная процедура сортирует одновременно по полю Альбом и Номер трека. И несмотря ни на что делает это за ~0.85с на тех же самых 6546 объектах в коллекции.

В итоге скорость увеличилась чуть ли не в 10 раз от изначальной) круто

Ответить

Номер ответа: 7
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #7 Добавлено: 08.12.09 23:59
Ты бы мог получить 600-кратное увеличение скорости по сравнению с изначальной, если б перешел на дотнет и воспользовался библиотечной функцией List.Sort

Ответить

Номер ответа: 8
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #8
Добавлено: 09.12.09 00:34
если только на с++/qt. в перспективе.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам