Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: Пред. 1 2 3 4 5 6 7 8 След.
RSS
Сортировка в двумерном массиве VBA Excel, Написал тут небольшую процедурку, может кому будет полезна
 
#151
15.03.2019 12:19:49
Цитата
Jack Famous написал:
я боюсь лезть)
не стоит боятся. В худшем случае процедура просто прервется с ошибкой.

На тему моей не скромной оценки скорости  - оценка производилась на основе уже опробованных сортировщиков, и вполне вероятно, что у опытных программистов вроде Казанского и других такого-же уровня есть под рукой процедуры более производительные)
 
 
 
#152
15.03.2019 14:22:07
Цитата
Anchoret: не стоит боятся
а будет ли она быстрее классики?
Цитата
Anchoret: есть под рукой процедуры более производительные
пусть поделятся тогда)))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#153
15.03.2019 18:41:35
Цитата
Jack Famous написал:
а будет ли она быстрее  классики ?
В тестере, где сравнивалось время сортировки: моей двух видов с досортингом от AAF, сортировка от AAF в чистов виде, QuickSort - вроде от Слэна. Раница была минимальной, при учете того, что все они были через индексы, а не лопатились "строки" массива при каждом свопинге. По сравнению с ними этот сортер текста примерно на секунду быстрее на 1кк строках. Если в соотношении, то 4с к 5с. Но время у всех разное и зависит от железа и прочего. На рабочем компе с i5 все сортируется за 2 с с хвостиком, на домашнем - за 4 с копейками.
В любом случае сможете замерить и сравнить самостоятельно)

П.С.: Спасибо за ссылку, хотя я там и был до этого, но зато при очередном просмотре понял почему солнце жёлтое, а трава зелёная :) Речь о внезапной тормознутости Квика в моём объекте/классе - все дело в скобках, т.е. в передаче процедуре динамического массива вместо вариантной переменной. За это спасибо ZVI)
Изменено: Anchoret - 15.03.2019 19:40:53
 
 
 
#154
16.03.2019 20:22:06
Ещё один, только по числам (отрицательные/положительные) по аналогичному принципу.
- "Ахилесова пята" - не учитывает изначальную сортированность массива, т.е. будет сортировать что отсортированный, что не отсортированный массив одно время
- разброс числовых значений не имеет значения
Код
Type mDbl: d As Double: End Type
Type bArr: b(7) As Byte: End Type
'------------------------------------------------------
Sub NumSort(arr(), ByVal n&)
Dim bMap(), BB() As bArr, d As mDbl, m&, p&
Dim a&, b&, c&, dd&(), aa&(), x&, xx&
'------------------------------------------------------
ReDim BB(1 To (UBound(arr) - LBound(arr) + 1)): ReDim dd(LBound(arr) To UBound(arr))
x = LBound(arr) And 1 Xor 1
For a = LBound(arr) To UBound(arr)
  d.d = arr(a, n): LSet BB(a + x) = d: dd(a) = a
  If BB(a + x).b(7) And 128 Then m = m + 1 Else p = p + 1
Next
For a = 4 To 7: ReDim bMap(0 To 255): c = 0
  For b = LBound(dd) To UBound(dd)
    bMap(BB(dd(b)).b(a)) = bMap(BB(dd(b)).b(a)) + 1
  Next
  For b = LBound(dd) To UBound(dd)
    If IsArray(bMap(BB(dd(b)).b(a))) Then
      bMap(BB(dd(b)).b(a))(0) = bMap(BB(dd(b)).b(a))(0) + 1: bMap(BB(dd(b)).b(a))(bMap(BB(dd(b)).b(a))(0)) = dd(b)
    Else: ReDim aa(0 To bMap(BB(dd(b)).b(a))): aa(0) = 1: aa(1) = dd(b): bMap(BB(dd(b)).b(a)) = aa
    End If
  Next: xx = LBound(dd)
  For b = 0 To 255
    If IsArray(bMap(b)) Then
      For c = 1 To bMap(b)(0): dd(xx) = bMap(b)(c): xx = xx + 1: Next
    End If
  Next
Next: Erase bMap: aa = dd: p = m + 1
For a = LBound(dd) To UBound(dd)
  If BB(dd(a)).b(7) And 128 Then aa(m) = dd(a): m = m - 1 Else: aa(p) = dd(a): p = p + 1
Next: dd = aa
For a = 2 To UBound(aa): x = a
  Do While arr(dd(x - 1), n) > arr(aa(a), n)
    dd(x) = dd(x - 1): x = x - 1
    If x = 1 Then Exit Do
  Loop
  dd(x) = aa(a)
Next: x = LBound(arr, 2): xx = UBound(arr, 2): Erase aa
ReDim bMap(LBound(arr) To UBound(arr), x To xx)
If LBound(arr) = 0 Then c = 1 Else c = 0
For a = 1 To UBound(dd)
  For b = x To xx: bMap(a + c, b) = arr(dd(a), b): Next
Next
arr = bMap: Erase dd: Erase bMap
End Sub

Без проверки на пустоты. Скоростью особо не блещет - примерно равное время с индексным QuickSort.
В приложенном файле в единственном модуле комплексный тестер.
Изменено: Anchoret - 19.03.2019 19:24:45
 
 
 
#155
18.03.2019 10:09:33
Цитата
Anchoret: Спасибо за ссылку
всегда пожалуйста — их есть у нас))
Цитата
Anchoret: Ещё один, только по числам
спасибо! Протестирую…

UPD: функция из процедуры очень шустрая — спасибо! Массив (5000,5) корректно сортируется за 0,02 сек по столбцу с положительными числами с 4мя знаками после запятой
Код функции
Изменено: Jack Famous - 26.03.2019 10:51:13 (Обновлено после обновления поста #147 от 19-03-2019 19:20:04)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#156
18.03.2019 18:12:55
Jack Famous, если переделать отдельно для Integer, то будет почти в два раза быстрее. Байтовые числа соответственно еще быстрее после переделки  - всего один проход по распределению, даже досортировка не нужна будет. Вообще надо будет потестить вариант без досортинга,вдруг он и не нужен...
Досортинг нужен... 1 смещение при 10к, 243 при 100к. Визуализатор
Изменено: Anchoret - 18.03.2019 19:38:34
 
 
 
#157
18.03.2019 19:03:11
Anchoret, а если добавить переменную "максимальное кол-во знаков после запятой" и потом умножать каждый элемент на 10^переменная?
Вот и целочисленное…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#158
18.03.2019 19:19:00
Jack Famous, там не считаются знаки ни после запятой ни до нее) Просто раскладывается число Double на 8 байт, потом с 4 по 7 байты идет цикличное распределение по матрице 0-255, слив всех индексов с матрицы в единый массив, и заново. Затем проверяется старший бит старшего же байта (если он включен, то число отрицательное, если нет, то положительное). Ну а в конце - досортировка вставками по полученному индексному массиву. При этом при всем нет взаимосмещений индексов по равным элементам. Т.е. для двумерного массива такая сортировка корректна, в отличии от QuickSort и прочих шейкеров.

В сортировке текста также идет превращение строки в массив байтов, но только не всей, а первых трёх символов (выяснено опытным путём, что большего и не нужно). Проход от 3-го байта к первому, сборка индексного массива, вставки, сборка итогового массива по индексному. Всё.
------------
Обновил числовой сортер.
Изменено: Anchoret - 19.03.2019 02:49:44
 
 
 
#159
19.03.2019 10:53:00
Anchoret, в принципе, почти всё понял)) спасибо вам! Код обновили или только файл (мне не сравнить)?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#160
19.03.2019 17:57:25
Anchoret, Подскажите по сортировке CleverSort_UPD_, там установлено option base 1, могу ли я проставить этот параметр в 0 ? Дело в том что у меня в массив передается таблица через ADODB.Recordset, и она начинается с 0, собственно не получается из-за этого использовать Ваше решение(
 
 
 
#161
19.03.2019 18:35:43
Jack Famous, и то и другое)
ALFA, бегло просмотрел код - да, можно убрать Option Base 1. И это не только моё решение, писалось в соавторстве с AAF :)
-------
Последние пару дней пытаюсь внедрить последние придумки по числовой и текстовой сортировке в CleverSort. Скоро выложу сюда обновлённый вариант.

П.С.: в Клевере обнаружен трудно отловимый баг - при сортировке текста значения в массиве иногда дублируются... А так там хренова куча кода, то разобраться не просто. Если нужен текстовый сортер, то лучше использовать одно из последних решений от AAF или моё (нужно проверить как он будет сортировать массив с нижней границей в 0, есть вероятность что не очень корректно...).
 
 
 
#162
19.03.2019 19:03:54
Anchoret, все понятно. Пасиба!
 
 
 
#163
19.03.2019 19:21:29
ALFA, изменил код текстового сортера в № 147.
 
 
 
#164
19.03.2019 19:31:22
Anchoret,под текстовым сортером подразумевается что столбец по которому выполняется сортировка содержит текст, верно?
То что происходит в этой теме просто огонь... Было время никак не мог найти решение по сортировке))
 
 
 
#165
19.03.2019 19:40:10
Цитата
ALFA написал:
столбец по которому выполняется сортировка содержит текст, верно?
Да)
 
 
 
#166
20.03.2019 02:45:26
Добавил таки новый сортировщик текста и чисел (частично, в основном на досортировке длинных хвостов). Провёл эксперимент с альтернативой сортировщика дат - эксперимент провалился (долго сортирует). Попутно исправил ошибку в сортировщике чисел (убрал Option Base, и в одном месте кода не была проставлена нижняя граница расширяемого массива) и дат (не правильно считались минимумы с максимумами).
Изменено: Anchoret - 20.03.2019 19:14:44
 
 
 
#167
20.03.2019 09:23:24
Цитата
Anchoret написал:
убрал Option Base
не стоит ли заменить нижнюю границу 1 на 0 в строке
Код
ReDim T1A(1 To UBound(mass, 1))
?
 
 
 
#168
20.03.2019 09:33:13
ALFA, а лучше вот так, чтобы не пересчитывать все остальные переменные (это будущий массив индексов):
Код
ReDim T1A(1 To UBound(mass) - LBound(mass) + 1)
 
 
 
#169
20.03.2019 10:07:05
Anchoret, в следующем участке массив gg сформирован с 1 в то время как sArr с 0, цикл падает так как верхний предел отличается на еденицу.

Код
  For a = LBound(gg) To UBound(gg)
    For c = LBound(mass, 2) To UBound(mass, 2)
      sArr(a, c) = mass(gg(a), c)
    Next c
  Next a: Erase gg
 
 
 
#170
20.03.2019 19:14:20
ALFA, с чего бы это:
Код
  'первичный индексный массив
  ReDim gg(LBound(mass, 1) To UBound(mass, 1))

---------------
В ходе очередного теста были выявлены ошибки, точнее их наличие, при сортировке миксованных по типам данных. немного подкорректированную версию выложил в #166. Но ошибки не все еще устранены...
 
 
 
#171
22.03.2019 18:28:11
Anchoret, а вы попутно обновляете сортеры из вашего пользовательского словаря?))) А то я как раз им заинтересовался…)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#172
22.03.2019 19:12:41
Jack Famous, Clever'а я туда не впихивал, если Вы об этом. Он слишком огромен и все еще косячит на миксах.
 
 
 
#173
22.03.2019 19:20:30
Anchoret, я про стабильность) главное, чтобы всё работало  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#174
22.03.2019 19:27:46
Jack Famous, все сортеры по отдельности работают нормально. во всяком случае те, что недавно добавлены. Двоичное древо в числовом сортере работает через раз, буду от него избавляться. Но времени пока не очень много.
 
 
 
#175
22.03.2019 19:32:52
Anchoret, вас понял) буду держать руку на пульсе)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#176
28.03.2019 08:21:11
Ещё дин числовой сортер на ограниченный диапазон чисел, но быстрее:
Код
Type mLng: l As Long: End Type
Type blArr: b(3) As Byte: End Type
'--------------------------------------
Sub NumSortL(arr(), ByVal n&)
Dim bMap(), bb() As blArr, d As mLng, m&, p&
Dim a&, b&, c&, dd&(), aa&(), x&, xx&
'------------------------------------------------------
ReDim bb(1 To (UBound(arr) - LBound(arr) + 1)): ReDim dd(LBound(arr) To UBound(arr))
x = LBound(arr) And 1 Xor 1
For a = LBound(arr) To UBound(arr)
  d.l = arr(a, n): LSet bb(a + x) = d: dd(a) = a
  If bb(a + x).b(3) And 128 Then m = m + 1 Else p = p + 1
Next
For a = 1 To 3: ReDim bMap(0 To 255): c = 0
  For b = LBound(dd) To UBound(dd)
    bMap(bb(dd(b)).b(a)) = bMap(bb(dd(b)).b(a)) + 1
  Next
  For b = LBound(dd) To UBound(dd)
    If IsArray(bMap(bb(dd(b)).b(a))) Then
      bMap(bb(dd(b)).b(a))(0) = bMap(bb(dd(b)).b(a))(0) + 1: bMap(bb(dd(b)).b(a))(bMap(bb(dd(b)).b(a))(0)) = dd(b)
    Else: ReDim aa(0 To bMap(bb(dd(b)).b(a))): aa(0) = 1: aa(1) = dd(b): bMap(bb(dd(b)).b(a)) = aa
    End If
  Next: xx = LBound(dd)
  For b = 0 To 255
    If IsArray(bMap(b)) Then
      For c = 1 To bMap(b)(0): dd(xx) = bMap(b)(c): xx = xx + 1: Next
    End If
  Next
Next: Erase bMap: aa = dd: p = m + 1: m = 1
For a = LBound(dd) To UBound(dd)
  If bb(dd(a)).b(3) And 128 Then aa(m) = dd(a): m = m + 1 Else: aa(p) = dd(a): p = p + 1
Next
dd = aa
For a = 2 To UBound(aa): x = a
  Do While arr(dd(x - 1), n) > arr(aa(a), n)
    dd(x) = dd(x - 1): x = x - 1
    If x = 1 Then Exit Do
  Loop
  dd(x) = aa(a)
Next: x = LBound(arr, 2): xx = UBound(arr, 2): Erase aa
ReDim bMap(LBound(arr) To UBound(arr), x To xx)
If LBound(arr) = 0 Then c = 1 Else c = 0
For a = 1 To UBound(dd)
  For b = x To xx: bMap(a + c, b) = arr(dd(a), b): Next
Next
arr = bMap: Erase dd: Erase bMap
End Sub

Диапазон от -16777215 до 16777215. При распределении дробная часть срезается, за счёт этого:
- уменьшается объем памяти занимаемый байтовым массивом с 8 на 4 байта под каждый элемент
- кол-во итераций распределения уменьшается на одну

При доводке вставками сравниваются уже оригинальные числа из сортированного массива, поэтому с дробной частью все ОК)
Если разделить сортер на два  - для отрицательных и положительных чисел отдельно, то ещё выиграем в скорости.
------------------
На моём домашнем драндулете получились такие тайминги:
Код
NumSort sorting, time: 3,172 Arr.1000000/1
NumSortL sorting, time: 2,734 Arr.1000000/1
AL.Sort sorting, time: 3,939 Array: 1000000/1

Последний испытуемый  - QuickSort упрощенной реализации. Первый - предыдущая версия числового сортировщика на Double.
Изменено: Anchoret - 28.03.2019 08:37:07
 
 
 
#177
28.03.2019 08:54:57
Anchoret, доброго утра!
Правильно ли я понял, что миллион сортируется 2,734 сек на новом сортере?
Какие ещё ограничения по числам, кроме "рамки" целочисленного диапазона? Например, кол-во знаков после запятой… Сколько вы использовали в тесте?

Не могли бы вы сделать частный случай сортировки для целых положительных чисел до 1 млн (1 — 1 000 000)? Хочу использовать для сортировки по номеру строки))) Я так понимаю, что такой частный случай сильно ускорит макрос
Изменено: Jack Famous - 28.03.2019 08:55:30
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#178
28.03.2019 09:12:49
Цитата
Jack Famous написал:
что миллион сортируется 2,734 сек на новом сортере?
Для каждого компа будет разное время. Как и писал ранее - на Intel'ах быстрее почти в два раза.
Цитата
Jack Famous написал:
Какие ещё ограничения по числам, кроме "рамки" целочисленного диапазона?
Не целочисленного диапазона. Все, что после запятой просто убирается с округлением по всем правилам при неявной конвертации входного числа в тип Long. Кол-во знаков после запятой не имеет значения.
Цитата
Jack Famous написал:
Не могли бы вы сделать частный случай сортировки для целых положительных чисел до 1 млн (1 — 1 000 000)?
Это Вы и сами сможете сделать (12-ю строку, 30-32 строки уберите из кода, ну и до кучи переменные m и p уже станут не нужны) :) Но для начала почитайте как компьютер видит числа. Точнее в каком виде они хранятся и прочее.

И для равномерно распределенных целых чисел лучше подойдет такой сортировщик.
Изменено: Anchoret - 28.03.2019 09:28:03
 
 
 
#179
28.03.2019 11:01:22
Anchoret, большое вам спасибо!  :)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#180
19.04.2019 18:22:54
Anchoret, приветствую!
Оказывается, текстовые ключи короче 3 символов — не срабатывают (прим. к #147)
КОД
Изменено: Jack Famous - 19.04.2019 18:24:10
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: Пред. 1 2 3 4 5 6 7 8 След.
Наверх