Страницы: 1 2 След.
RSS
как в VBA отсортировать массив?
 
кроме как на листе, конечно..
Живи и дай жить..
 
http://www.planetaexcel.ru/forum.php?thread_id=5274
 
Вообще есть куча разнообразных способов и методов... Вот еще один: http://www.vbrussian.com/Article.asp?ID=97  
P.S. Google рулит)
 
а с использованием стандартных функций( Сишных, например) никто не видел?  
 
я тоже надыбал одну ссылку по реализации алгоритма quicksort на VBA, но уже нашел там ошибку..
Живи и дай жить..
 
Очень интересные демо показы различных сортировок  
 
http://www.cs.ubc.ca/~harrison/Java/sorting-demo.html
 
Может кто-нибудь переведёт сортировку Fast Quick Sort  (by Denis Ahrens) с Си на VBA ? )  
 
Тут Demo (внизу) http://www.cs.ubc.ca/~harrison/Java/sorting-demo.html  
 
а тут код  
 
http://www.cs.ubc.ca/~harrison/Java/FastQSortAlgorithm.java.html
 
В VBA насколько я понимаю, ф-ции swap нету. Значит, напрямую преобразовать Си-пример в код VBA не получится. Вот в этой теме - http://www.planetaexcel.ru/forum.php?thread_id=5274 (была указана выше) - Турбо-Ёж впроде бы предлагал подогнаный под Excel метод Fast Quick Sort.
 
Блин, до конца не разобрался) Swap - это ж отдельная процедура) Тогда пример Турбо-Ежа - точно Fast Quick Sort.
 
Потестил 2 способа Ежа и по ссылке http://www.vbrussian.com/Article.asp?ID=97  
с помощью  
Sub TestSort()  
   Dim iEntry()  
   Dim j: j = 1000000  
   ReDim iEntry(1 To j)  
   For iOuter = LBound(iEntry()) To UBound(iEntry())  
       iEntry(iOuter) = Int((20 * Rnd) - 10)  
   Next  
  Start1 = Timer  
  Call ShellSort2(iEntry())  
  MsgBox Format((Timer - Start1), "00:00")  
End Sub  
 
Так вот, сортировка Ежа на миллионе случайных чисел - 21 секунда, вторая сортировка - 7 секунд..  
Кстати, может кто-нибудь знает алгоритм извлечения уникальных элементов,кроме последовательного перебора отсортированного массива
 
скачал алгоритм qsort с www.cpearson.com  
только там в "NumberOfArrayDimensions" надо заменить как минимум  
Dim Res As Integer    на           Dim Res As long  
а лучше вообще так:  
Private Function NumberOfArrayDimensions(arr As Variant) As Integer  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''­''''''''''''''''''''''''''''''''''''''''  
' NumberOfArrayDimensions  
' This function returns the number of dimensions of an array. An unallocated dynamic array  
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''­'''''''''''''''''''''''''''''''''''''''''  
Dim Ndx As Long  
On Error GoTo ex  
' Loop, increasing the dimension index Ndx, until an error occurs.  
' An error will occur when Ndx exceeds the number of dimension  
' in the array. Return Ndx - 1.  
Do  
    Ndx = Ndx + 1  
   If UBound(arr, Ndx) Then:  
Loop  
   
ex: NumberOfArrayDimensions = Ndx - 1  
   
End Function  
 
а так довольно быстро работает.
Живи и дай жить..
 
{quote}{login=Артем}{date=09.01.2009 07:35}{thema=}{post}Потестил 2 способа Ежа и по ссылке http://www.vbrussian.com/Article.asp?ID=97  
с помощью  
Sub TestSort()  
   Dim iEntry()  
   Dim j: j = 1000000  
   ReDim iEntry(1 To j)  
   For iOuter = LBound(iEntry()) To UBound(iEntry())  
       iEntry(iOuter) = Int((20 * Rnd) - 10)  
   Next  
  Start1 = Timer  
  Call ShellSort2(iEntry())  
  MsgBox Format((Timer - Start1), "00:00")  
End Sub  
 
Так вот, сортировка Ежа на миллионе случайных чисел - 21 секунда, вторая сортировка - 7 секунд..  
Кстати, может кто-нибудь знает алгоритм извлечения уникальных элементов,кроме последовательного перебора отсортированного массива{/post}{/quote}  
 
 
по извлечению уникальных элементов посмотрите здесь:http://sql.ru/forum/actualthread.aspx?bid=46&tid=333152&pg=-1  
сортировать не надо..  
лучший способ с scripting.dictionary  
но и с коллекциями очень неплохо..  
 
на миллионе не пробовал, но на 60000(в 2003 икселе) доли секунды..
Живи и дай жить..
 
спасибо
 
В приложенном архиве 3 файла  
 
1) сортировка от Chip Pearson, которую дал Слэн  
2) сортировка по методу Шелла с сайта http://www.vbrussian.com/Article.asp?ID=97  
3) сортировка взятая отсюда http://www.vbnet.ru/forum/show.aspx?id=90781&page=1  
 
По моим результатам 3-й вариант самый быстрый. Если я не прав, поправьте меня.
 
Добрый вечер, Слэн! и всем ;-)  
 
Алгоритмов VBA-сортировки опубликовано достаточно много.    
Прилагаю небольшой архивчик методов сортировки, когда-то надёрганных из Интернета.  
 
Вот здесь хороший ресурс по методам сортировки на нескольких языках программирования:  
http://alglib.sources.ru/sorting/  
Там же есть и статья по сравнению эффективности алгоритмов сортировки массивов:  
http://alglib.sources.ru/articles/sort.php  
Только советую творчески отнестись к коду и оценкам, так как из-за универсальности код не оптимизирован. И на VB (VBA) можно получить иные результаты эффективности.  
Кстати, на этом же сайте приведено множество интересных методов матобработки.  
 
Эффективность сортировки  сильно зависит от размера массива, типа данных, метода сортировки, компилятора и/или среды программирования. В частности, по моим оценкам, на обработках длинных строк при прочих равных условиях  компилятор Borland C++ в 2 … 2.5 раза быстрее компилятора Visual C++.  Но и функциями VBA можно написать код, который обрабатывает строки в несколько раз быстрее, чем некоторые другие встроенные VBA-функции, написанные на C(++), если вместо автоматизации по скорости компилятора для конкретной задачи написать более оптимальный код, понимая, где реальные тормоза: memory reallocation, adjusting of addresses etc.  
   
Известны также  методы сортировки коллекций, но они неэффективны на больших массивах:    
http://www.dailydoseofexcel.com/archives/2004/06/02/sort-a-collection/  
http://www.freevbcode.com/ShowCode.asp?ID=3645  
Впрочем, использование дополнительного индексного массива заслуживает внимания:  
http://www.source-code.biz/snippets/vbasic/  
Индексный массив особенно насущен и для сортировки многомерных массивов.  
 
На мой взгляд, в дополнение к использованию индексного массива представляет интерес свопинг не самих переменных, а их адресов с помощью API CopyMemory  (RtlMoveMemory). Подозреваю, что Excel как и поступает, но реальных тестов эффективности этого метода я не проводил.
 
согласен с Павлом, метод с Vbnet самый быстрый - на моем ПК миллион значений обрабытывает за 5 сек, пирсоновский аж 34 секунды.(Не смотрел пока то что выложил ZVI)
 
метод бинарных деревьев(при прочих равных) - 6,6 секунд однако...
 
Хм, а кто знает, как запустить этот метод бинарных деревьев с одномерным массивом? ))  
 
Объявил массив  
 
Dim MyArr() As Double, i As Long  
 
   ReDim MyArr(0 To 50000)  
   For i = 0 To 50000  
       MyArr(i) = Round(Rnd * 50000, 0)  
   Next i  
 
 
Вызываю процедуру сортировки    
 
HeapSort MyArr(), 1    
 
1 - т.е. одномерный массив (в процедуре написано указывать размерность)  
 
но процедура сразу заканчивается, т.к. в начале процедуры написано    
 
   If N = 1# Then  
       Exit Sub  
   End If  
 
С размерностью 0 - выходит ошибка (ну, это логично)  
с размерностю 2 - сортировка не происходит.    
 
Файл прилагаю.
 
ZVI, в твоём архиве в файле Sort_Routines.xls (где представлены различные методы сортировки) в модуле modHeapSort (метод бинарных деревьев) неправильно объявлены многие переменные, типа  
 
Dim base, n, nn, i, m As Long  
Dim base, nDiv2, i, k As Long  
 
При таком объявлении, при сортировке 50000 целых чисел у меня был лучший результат 1500 мс, при правильном объявлении всех этим переменных лучшим результатом стало 1047 мс, т.е. почти 500 мс выигрыш.  
 
Я понимаю, это камень не в твой огород, а в огород автора файла.  
 
Но всё равно очень долго работает этот метод бинарных деревьев  
- сперва циклом заполняется массив значениями с листа  
- почему-то долго сортируется  
- циклом долго выводим результат обратно на лист  
 
Кстати, в этом же файле в модуле modMain, автор файла явно пишет, что он предпочитает из всех методов QuickSort, вот эта строка  
 
varray2 = modQuickSort.Quicksort(varray) 'Preferred Method of Sorting  
 
Ох, что-то я не пойму. Все говорят, что метод бинарных деревьев самый быстрый, но при тестировании он почему-то самый долгий ))  
 
Может у меня руки кривые? Разъясни, плиз )  
 
Файл с мет. Бинар. деревьев из твоего файла прилагаю.  
 
 
Я пытаюсь найти самый максимально быстрый способ сортировки массивов на листе Excel, как текстовых, так и числовых.
 
Потестировал я сортировку QuickSort из файла Sort_Routines.xls, которую так полюбил автор этого файла. При тестировании я чуть не умер... лучший результат ... эм вам в миллисекундах сказать или лучше в минутах? )) В общем 252312 мс, на сколько я понимаю, это 4,2 минуты.    
 
Файл прикладываю.  
 
На сколько я понимаю, всё-таки самый быстрый пока остаётся 3-й вариант из моего поста post_44028.xls (http://www.planetaexcel.ru/docs/forum_upload/post_44028.rar), который я выложил выше в этой теме. Так?  
 
так... 5 утра ... надо ложиться спать. Всем споки.
 
По моему посту выше, где я не мог запустить сортировку с методом бинарных деревьев. Я просто неправильно прочитал название аргумента. Надо читать N - размер массива, а я прочитал "размерность массива" - из-за этого не мог запустить процедуру.  
 
В общем, я сегодня потестировал две версия сортировки методом бинарных деревьев. Оба они оказались не самыми лучшими. Или я, может, что-то делаю не так.  
 
Как я уже и сказал, пока лучшим остаётся 3-й вариант файла в посте    
http://www.planetaexcel.ru/docs/forum_upload/post_44028.rar  
 
2 файла с бинарными деревьями выкладываю на вашего тестирования и анализа  
 
а я спать, всем споки
 
Насчет оценок методов я предупреждал :) в VBA результаты методов иные, чем на C++. Коды, что приложил в архиве, не мои, рассматривайте их просто как (до)исторические :-)  
А метод, выбранный Павлом, действительно работает очень шустро.    
Да и сам Павел поработал этой ночкой очень плодотворно, за что ему большое спасибо.    
Интересно было бы, конечно, достичь в VBA скорости сортировки Excel-я.  
А то в определенных случаях все же приходится сортировать в ячейках.
 
да, вариант qsort без рекурсии - лучший, но почти в два раза медленнее икселевской сортировки  
 
непонятки:  
 
когда вызываю как процедуру, т.е например: call qsort(arr)  
отсортированный  массив не передается обратно в процедуру и , соответственно, не отображается на листе..  
 
если же вызывать как функцию: if qsort(arr) then:  
то все нормально.  
 
и второе - оправдано ли оформление функцией простых действий? типа swap - в одном месте в коде употребляется  - не проще ли прямо там и записать алгоритм swap?  
в другом месте - сравнение двух величин оформлено функцией.. я понимаю, когда пишется универсальный код, заранее неизвестны типы данных, тогда в процедуру сортировки передается УКАЗАТЕЛЬ на функцию сравнения, кот вы выбираете сами(или можно выбирать автоматически, но это хуже).  
 
хотя, конечно, это и несущественное замедление.. но если таких функций насовать туда поболе..
Живи и дай жить..
 
В варианте Павла, работает и  Call QuickSortNonRecursive(Rng) и просто QuickSortNonRecursive Rng.  
 
Насчет swap все правильно: для уменьшения времени лучше явно вписать перестановку в общую процедуру, чем многократно вызывать функцию. Сам вызов функции на любом языке программирования - это время, не говоря уже о времени на создание локальных переменных внутри функции при каждом вызове и еще, возможно, на приведение типов данных.  
Например, в С, когда нужна скорость, вместо вызова функций используют макросы типа #define isdigit(x) ((x) >= '0' && (x) <= '9'), которые компилятор подсовывает в каждое место, откуда вызывался макрос. Но, с другой стороны, это увеличивает размер кода.  
В VBA тоже код увеличивается в размере, если подстановку (swap) потребуется вписать в несколько мест, зато сэкономится время тем большее, чем больше обрабатывемый массив.
 
Может кто-нибудь изменит макрос (QuickSort без рекурсии), как вы считаете будет быстрее, т.е. swap вставите внутрь процедуры? Чтобы, как говорится, вышла максимально быстрая процедура? (а то у меня что-то голова сегодня не работает)
 
крутил-крутил.. кроме swap ничего улучшить не получается. ну памяти чуть сэкономил, но и это еще вопрос :)  
Public Sub QuickSortNonRecursive(SortArray As Variant)  
Dim i As Long, j As Long, lb As Long, ub As Long  
Dim stack() As QuickStack, stackpos As Long, ppos As Long, pivot As Variant, swp  
   ReDim stack(1 To 64)  
   stackpos = 1  
 
   stack(1).Low = LBound(SortArray)  
   stack(1).High = UBound(SortArray)  
   Do  
       'Взять границы lb и ub текущего массива из стека.  
       lb = stack(stackpos).Low  
       ub = stack(stackpos).High  
       stackpos = stackpos - 1  
       Do  
           'Шаг 1. Разделение по элементу pivot  
           ppos = (lb + ub) \ 2  
           i = lb: j = ub: pivot = SortArray(ppos)  
           Do  
                While SortArray(i) < pivot: i = i + 1: Wend  
                While pivot < SortArray(j): j = j - 1: Wend  
                If i <= j Then  
                    swp = SortArray(i): SortArray(i) = SortArray(j): SortArray(j) = swp  
                    i = i + 1  
                    j = j - 1  
               End If  
          Loop While i <= j  
 
           'Сейчас указатель i указывает на начало правого подмассива,  
           'j - на конец левого lb ? j ? i ? ub.  
           'Возможен случай, когда указатель i или j выходит за границу массива  
           'Шаги 2, 3. Отправляем большую часть в стек  и двигаем lb,ub  
 
           If i < ppos Then   'правая часть больше  
               If i < ub Then  
                   stackpos = stackpos + 1  
                   If stackpos > UBound(stack) Then ReDim Preserve stack(1 To UBound(stack) + 32)  
                   stack(stackpos).Low = i  
                   stack(stackpos).High = ub  
               End If  
               ub = j        'следующая итерация разделения будет работать с левой частью  
           Else  
               If j > lb Then  
                   stackpos = stackpos + 1  
                   If stackpos > UBound(stack) Then ReDim Preserve stack(1 To UBound(stack) + 32)  
                   stack(stackpos).Low = lb  
                   stack(stackpos).High = j  
               End If  
               lb = i  
           End If  
       Loop While lb < ub  
   Loop While stackpos  
End Sub
Живи и дай жить..
 
Да, действительно быстрее. Спасибо, Слэн.  
 
Итак, выкладываю 2 варианта  
1) Самый быстрый для текста  
2) Самый быстрый для чисел  
 
Они оба основаны на сортировке QuickSort без рекурсий, но с разными типами переменных в функции Swap (в одном случае переменные типа Variant, в другом String)  
 
P.S. Совместить два в одном, чтобы макрос быстро обрабатывал и текст и числа. У меня не вышло.
 
Павел, у Слэна как раз и сделан вариант как для строк, так и для чисел.  
Только если вместо:  
Public Sub QuickSortNonRecursive(SortArray As Variant)  
написать:  
Public Sub QuickSortNonRecursive(SortArray() As Variant)  
то будет примерно в 1.6 раза быстрее.  
Всего лишь 2 скобки добавили :-)  
 
В приложении немного переделанный файл для совместной сортировки строк и чисел.
 
вот так вот :)  спасибо , научили..  
 
осталось чуть-чуть
Живи и дай жить..
 
интересно, ZVI, почему именно умножать на 2 при увеличении массива stack?  
 
это не слишком? ведь выход за пределы массива вовсе не обозначает, что потребуется еще столько же уровней, скорее наоборот.. можно даже предположить сколько понадобится по формуле:  
например, для                 If i < ub Then  
                   stackpos = stackpos + 1  
 
можно оценить как:  (ub-i)/(ub-lb)*stackpos  
 
да и на самом деле, для случайных чисел , количество уровней колеблется в пределах: 10-11  
а при изначально упорядоченном массиве, возрастает лишь до 14  
 
на массиве из 65000 значений  
 
ps  не лень вам ждать каждый раз пока массив создается? да икак в таком случае сравнивать методы?  
 
свой файл прилагаю. перед первой сортировкой(ну и , соответственно, по желанию) нажать "поменять массив"
Живи и дай жить..
 
или умножение просто быстрее сложения?
Живи и дай жить..
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх