Приветствую! Заинтересовался такой задачей: как можно ускорить фильтрацию двумерного массива? Далее под "фильтрацией таблицы" будет иметься в виду отбор строк двумерного массива, согласно критериев.
Давайте разбираться, что такое отбор/фильтрация на примере двумерного массива из таблицы
Итак, у нас есть тело (все данные без заголовков и итогов) Таблицы в виде двумерного массива a2D. В этом массиве rT (UBound (a2D, 1) ) строк и cT (UBound (a2D, 2) ) столбцов. Мы можем определить из этого массива cF полей, по которым мы хотим фильтровать таблицу. То есть: cT >= cF > 0. В общем смысле, фильтрация таблицы — это пересборка исходной таблицы с сохранением только тех строк, значения в которых по фильтруемым полям соответствуют условиям для этих полей.
Например, если я фильтрую таблицу по полю "Фамилия" и передаю критерий "Петров" и, также, фильтрую по полю "Имя" и передаю критерий "Василий", то, это значит, что я должен пройти по всем строкам Таблицы и оставить только те, у которых в поле "Фамилия" записано "Петров", а в поле "Имя" записано "Василий". И никак иначе.
Я решил разобрать [относительно] простой случай: Отбор не более, чем по одному значению — для каждого поля. Проверка осуществляется на строгое равенство, с учётом регистра. Алгоритм ускорения позволяет осуществить, также, проверку без учёта регистра и/или на НЕравенство, но в примере это не отражено.
Итак, как же ускорить? Чтобы ускорить, нужно как-то избавиться от цикла по всем строкам таблицы. Для этого нужно как-то запомнить строки для каждого критерия в фильтруемых столбцах и хранить их в ОЗУ (использовать статичные переменные). То есть, в любом случае, нужно собрать уникальные списки для каждого поля, которое хотим фильтровать.
Далее существует, минимум, 2 сценария:
• простой. Если количество комбинаций между всеми уникальными списками не выше порога (например, 100 млн), то можно использовать словарь (для не более чем 100 тыс. ключей )или массив словарей (для большего количества). Или суперсловарь от bedvit'а, у которого нет ограничения по ключам. Далее, мы "просто" получаем все эти комбинации и, для каждой из них, собираем массив строк, которые этой комбинации соответствуют. Пара: комбинация — массив. Тут ограничением является количество комбинаций — на 100 или даже 10 млн время получения этих комбинаций и массивов по ним может превысить допустимое время ожидания пользователя (устанавливается индивидуально). Если время формирования вас устраивает, то дальше всё просто: получаем параметры для фильтрации каждого поля, сцепляем в строку (по тем же правилам, как и при формировании ключей словаря) и, если такая строка есть в словаре, то просто получаем массив строк Таблицы и отбираем из неё в новый двумерный массив. Помимо относительной простоты, этот способ будет самым быстрым в получении массива строк по переданным параметрам. Кто считает, что такое (100 млн) количество комбинаций просто немыслимо напомню, что это, например 100 ^4, то есть, всего лишь 4 поля по 100 уникальных записей (минимальное количество комбинаций это произведение всех уникальных списков). И это минимум, потому что, если учитывать, что фильтры могут быть заданы НЕ для всех полей (как в примере) то это количество может быть значительно больше. • сложный. Что же делать, если 1ый вариант нас не устраивает? Как-то уйти от затратных по сбору комбинаций, очевидно. Я предлагаю [и показываю, как] собирать массив словарей, размером с количество полей, которые могут участвовать в фильтрации. Каждый элемент этого массива (словарь) содержит пары "критерий — массив строк". То есть, такой словарь для поля будет содержать столько ключей, сколько уникальных значений для этого поля. И для каждого ключа/значения будет содержать список строк, в которых оно встречается. Так мы уходим от необходимости комбинировать все возможные варианты сочетаний критериев. Это и было целью. Остаётся, при получении параметров отбора, найти в словарях все массивы со строками и, самое важное, найти ПЕРЕСЕЧЕНИЕ этих строк — то есть те номера строк, которые есть во всех отобранных массивах. Например, если передали только критерии для 2ух полей: Фамилия (= "Петров") и Имя (= "Василий"), то мы из соответствующих словарей (элементов массива словарей) находим список строк для (= "Петров"): {1, 2, 15, 89, 156} и для (= "Василий"): {3, 81 11, 15, 264} и понимаем/вычисляем, что общая строка у них всего одна (#15), а, значит и результирующий набор вывода будет состоять только из одной строки исходной таблицы.
Слабые места алгоритма, которые я хотел бы ускорить (существующими методами или библой bedvit'а): • сцепка по ключу (не очень страшно и есть альтернативы). Чтобы собрать номера строк в массив я использую накопительную строку, формируемую по принципу s = s & sSep & iRow. Есть и другие варианты ( Mid$(s, …) = sSep & iRow кажется самым быстрым, но сложнее в реализации). • определение общих значений (отсортированные целые числа) для N массивов. Тут я применил всё, что знал. Используется массив в качестве "словаря" для быстрой проверки и используется самый малый по размеру массив (т.к. если в нём нет номера строки, то она уже никак не может быть общей для всех массивов). Описывать очень долго — кто в теме, тот поймёт. Какие-то моменты всегда можно спросить и я отвечу. Так вот, для этого процесса мне бы очень не помешал специальный инструмент из библы — такие штуки на плюсах должны быть сильно быстрее. Думаю, что его применение может быть довольно широким.
Возможно, есть и другие способы, как ускорить отбор. Прошу поделиться
В файле 2 листа: исходная таблица для фильтрации и тестовый. В таблице можно добавлять/удалять строки. При уходе с листа произойдёт обновление. На тестовом можно выбрать от 1 до 4ёх критериев фильтра и нажать(даблклик) FILTER — справа выведется отфильтрованная таблица или сообщение, что под заданные параметры ничего не найдено.
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
' Work
'==================================================================================================
Function PRDX_StrToArrL(sIn$, sep$, aL_Out() As Long) As Boolean
Dim x, arr, n&
arr = Split(sIn, sep)
ReDim aL_Out(UBound(arr) + 1)
For Each x In arr
n = n + 1: aL_Out(n) = x
Next x
PRDX_StrToArrL = True
End Function
'==================================================================================================
' ' Faster than Dictionary
Function PRDX_ArrL_ChangeIndVal(aIn() As Long, aOut() As Long, Optional SetVal&) As Boolean
Dim UBnd&, r&, i&, n&
UBnd = 2 * UBound(aIn)
ReDim aOut(UBnd)
For r = 1 To UBound(aIn)
i = aIn(r): If (UBnd < i) Then UBnd = 2 * i: ReDim Preserve aOut(UBnd)
If (SetVal = 0) Then aOut(i) = r Else aOut(i) = SetVal
If (n < i) Then n = i
Next r
ReDim Preserve aOut(n)
PRDX_ArrL_ChangeIndVal = True
End Function
'--------------------------------------------------------------------------------------------------
Private Sub Test_PRDX_ArrL_ChangeIndVal()
Dim a&(), b&(), n&
PRDX_StrToArrL "5/3/2", "/", a
For n = 1 To UBound(a)
Debug.Print "a(" & n & ") = " & a(n) ' a(1) = 5; a(2) = 3; a(3) = 2
Next n
Debug.Print String$(20, "-")
PRDX_ArrL_ChangeIndVal a, b
For n = 1 To UBound(b)
Debug.Print "b(" & n & ") = " & b(n) ' b(1) = 0; b(2) = 3; b(3) = 2; b(4) = 0; b(5) = 1
Next n
Debug.Print String$(20, "-")
PRDX_ArrL_ChangeIndVal a, b, 100
For n = 1 To UBound(b)
Debug.Print "b(" & n & ") = " & b(n) ' b(1) = 0; b(2) = 100; b(3) = 100; b(4) = 0; b(5) = 100
Next n
End Sub
'==================================================================================================
' Main
'==================================================================================================
Private Function FillDic(a2D, nCol&, dicOut As Dictionary) As Boolean
Dim x, arr, aJ$(), aRows&()
Dim s$, r&, n&, nn&
Const sep$ = " "
Set dicOut = New Dictionary
ReDim aJ(UBound(a2D, 1), 2) ' Key, Join
For r = 1 To UBound(a2D, 1)
s = a2D(r, nCol)
If dicOut.Exists(s) Then
nn = dicOut(s): aJ(nn, 2) = aJ(nn, 2) & sep & r ' Slow
Else
n = n + 1: dicOut.Add s, n: aJ(n, 1) = s: aJ(n, 2) = r
End If
Next r
dicOut.RemoveAll
For r = 1 To n ' Convert "1 2 3" to Array(1, 2, 3) As Long
If Not PRDX_StrToArrL(aJ(r, 2), sep, aRows) Then Stop: End
dicOut.Add aJ(r, 1), aRows
Next r
FillDic = True
End Function
'==================================================================================================
Function PRDX_Tbl_ReCalc(a2D_Tbl, a1D_ColFilt, aDic_Out() As Dictionary) As Boolean
Dim x, n&
ReDim aDic_Out(UBound(a1D_ColFilt))
For Each x In a1D_ColFilt
n = n + 1: If Not FillDic(a2D_Tbl, --x, aDic_Out(n)) Then Stop: End
Next x
PRDX_Tbl_ReCalc = True
End Function
'==================================================================================================
'==================================================================================================
' Filter
'==================================================================================================
Private Function RowsOfDic(a1D_ColFilt, a1D_ColVal, a1D_ColIV, aDic() As Dictionary, aArrRows_Out()) As Boolean
Dim s$, n&, i&, p&
ReDim aArrRows_Out(UBound(a1D_ColIV))
For n = 1 To UBound(a1D_ColFilt)
i = a1D_ColIV(a1D_ColFilt(n)) ' Index of Col# a1D_ColFilt(n) in aDic()
If (i <> 0) Then
s = a1D_ColVal(n)
If aDic(i).Exists(s) Then p = p + 1: aArrRows_Out(p) = aDic(i)(s)
End If
Next n
If (p = 0) Then Exit Function
ReDim Preserve aArrRows_Out(p): RowsOfDic = True
End Function
'==================================================================================================
Private Function RowsInsersect(aArrRows(), aRows_Out() As Long) As Boolean
Dim x, aVI&()
Dim iMin&, UBnd&, n&, i&
If (UBound(aArrRows) = 1) Then aRows_Out = aArrRows(1): GoTo fn
iMin = UBound(aArrRows(1)): i = 1
For n = 2 To UBound(aArrRows) ' Find Minimal Array
UBnd = UBound(aArrRows(n))
If (iMin > UBnd) Then iMin = UBnd: i = n
Next n
aRows_Out = aArrRows(i) ' Set Minimal Array
If Not PRDX_ArrL_ChangeIndVal(aRows_Out, aVI, 1) Then Stop: End ' Set Array Like "Dictionary"
ReDim aRows_Out(UBound(aRows_Out))
On Error Resume Next
For n = 1 To UBound(aArrRows) ' Filter aRows_Out
If (n <> i) Then
For Each x In aArrRows(n)
aVI(x) = aVI(x) + 1
Next x
End If
Next n
On Error GoTo 0
n = 0: i = 0: UBnd = UBound(aArrRows)
For i = 1 To UBound(aVI)
If (aVI(i) = UBnd) Then n = n + 1: aRows_Out(n) = i
Next i
If (n = 0) Then Exit Function
ReDim Preserve aRows_Out(n)
fn: RowsInsersect = True
End Function
'==================================================================================================
Function PRDX_Tbl_Filter_GetRows(a1D_ColFilt, a1D_ColVal, a1D_ColIV, aDic() As Dictionary, aRows_Out() As Long) As Boolean
Dim aArrR()
If Not RowsOfDic(a1D_ColFilt, a1D_ColVal, a1D_ColIV, aDic, aArrR) Then Exit Function
PRDX_Tbl_Filter_GetRows = RowsInsersect(aArrR, aRows_Out)
End Function
'==================================================================================================
Function PRDX_Tbl_Filter_Arr2D(a2D_In, a2D_Out, aRows() As Long) As Boolean
Dim r&, rr&, c&
ReDim a2D_Out(UBound(aRows), UBound(a2D_In, 2))
For r = 1 To UBound(aRows)
rr = aRows(r)
For c = 1 To UBound(a2D_In, 2)
a2D_Out(r, c) = a2D_In(rr, c)
Next c
Next r
PRDX_Tbl_Filter_Arr2D = True
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
Модуль «PRDX_Example»
Код
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Public vp_aDic() As Dictionary, vp_aCol&(), vp_aColIV&()
'==================================================================================================
Function PRDX_Ex_TblUpdate(Optional Force As Boolean) As Boolean
Dim a
Static st&
If (st = 1) Then If Force Then st = 0 Else GoTo fn
If Not PRDX_StrToArrL("2/3/4/5", "/", vp_aCol) Then Stop: End
If Not PRDX_ArrL_ChangeIndVal(vp_aCol, vp_aColIV) Then Stop: End
a = shTbl.ListObjects(1).DataBodyRange.Value2
If Not PRDX_Tbl_ReCalc(a, vp_aCol, vp_aDic) Then Stop: End
st = 1
fn: PRDX_Ex_TblUpdate = True
End Function
'==================================================================================================
'==================================================================================================
Private Function GetFilter(aCol_Out() As Long, aVal_Out() As String) As Boolean
Dim arr, c&, n&
arr = shUniq.Range("A2:D2").Value2
ReDim aCol_Out(UBound(arr, 2)): ReDim aVal_Out(UBound(aCol_Out))
For c = 1 To UBound(arr, 2)
If Not IsEmpty(arr(1, c)) Then n = n + 1: aCol_Out(n) = c + 1: aVal_Out(n) = arr(1, c)
Next c
If (n = 0) Then Exit Function
ReDim Preserve aCol_Out(n), aVal_Out(n)
GetFilter = True
End Function
'--------------------------------------------------------------------------------------------------
Function PRDX_Ex_TblFilter() As Boolean
Dim cl As Range
Dim aTbl, aFlt(), aCol&(), aRows&(), aVal$()
If Not GetFilter(aCol, aVal) Then Exit Function
If Not PRDX_Ex_TblUpdate() Then Stop: End
Set cl = shUniq.Range("I5")
cl.Resize(shUniq.UsedRange.Rows.Count, 5).ClearContents
If Not PRDX_Tbl_Filter_GetRows(aCol, aVal, vp_aColIV, vp_aDic, aRows) Then Exit Function
aTbl = shTbl.ListObjects(1).DataBodyRange.Value2
If Not PRDX_Tbl_Filter_Arr2D(aTbl, aFlt, aRows) Then Stop: End
cl.Resize(UBound(aFlt, 1), UBound(aFlt, 2)).Value2 = aFlt
PRDX_Ex_TblFilter = True
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, привет! По твоей теме, можно кратко: 1.Почему не подходит фильтр из нашей библы? 2.Какой инструмент написанный на С++, ты думаешь будет широким в применении, кратко, концепцию?
1. Задача может быть решена с использованием библы или без неё. Без неё я показал. Наверняка, можно что-то ускорить, но кардинально отличаться может только другой подход. С помощью твоего фильтра всё будет гораздо проще. Более того, на малых и средних объёмах он, скорее всего, будет быстрее. И уж точно удобнее и проще. Также, не нужно будет тратить время на подготовку данных и их обновление — всё будет браться актуальное. Всегда. Однако, на больших объёмах он вполне может уступить (надо протестировать). Есть такие задачи, когла временем подготовки данных можно пожертвовать или даже пренебречь — лишь бы потом можно было очень быстро по этим данным получать необходимую информацию. Такой была задача по словарю лемм (решилась с помощью твоего метода загрузки пар через одномерный массив). Такая задача и тут.
Если бы не волшебная комбинаторика, то задача свелась к бы к получению всех комбинаций (не хватает скорости плюсов, а у тебя нет ничего по этой теме) с номерами строк — в твоей карте. Но, боюсь, что количество комбинаций может быть просто невообразимо огромным и средняя ОЗУ просто не вывезет. Нужно что-то другое.
2. Если просто повторить мой алгоритм, то скорость нужна в 3ёх местах: - получение пар "критерий — массив номеров" (для каждого заданного поля. - определение общих номеров (пересечения) из заданного массива массивов (номеров) - быстрый пересбор двумерного массива по заданному списку строк. Кстати, вообще, такой инструмент пересбора был бы очень полезен. На твоей стороне это намного быстрее происходит.
Возможно, другой подход изменит и потребности.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
bedvit: это уже реализованно в фильтре в нашей библе
ты лукавишь) Понятно, что фильтр может возвратить отфильтрованный массив. А может вернуть индексы. А, также, индексы могут быть получены другим путём. Нет самого инструмента для пересбора. Отдельно. Мне кажется, на плюсах будет быстрее, чем на VBA. К тому же, можно добавить аргумент массива номеров столбцов и отобрать не только по строкам, а ещё и по столбцам (не все взять и/или в другом порядке и/или задублировать). Кстати, задублировать можно и строки, повторяя индексы.
Очень не хватает твоей реализации сцепки по условию. Я пока придумал только попутно со словарём собирать 2 одномерных массива (строковый для сцепок и лонг для последней заполненной позиции). Наполнить строковый буферными строками большой длины и заполнять их МИДом, запоминая последнюю позицию в лонг-массив. В конце, обрезать все строки по известную позицию. Тут демонстрировать не стал, а то и так непростой код.
Мне очень понравился мой вариант определения пересечения элементов массива — прямо здорово получилось
А тест я, конечно, сделаю — мне и самому очень интересно.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Промежуточные тесты показывают, что за фильтром от BedVit'а мне не угнаться даже при "статичном подходе"
Учитывая новое удобство передачи критериев, огромные трудозатраты по организации "статичных" параметров и, конечно же, при всём этом, недостаточную для конкуренции скорость, я бы решал подобную задачу так: 1. Собираем все необходимые (присутствующие на листе или ещё как) комбинации параметров. Осуществляем это обновление по кнопке или событию. 2. Пропускаем их через фильтр из библы, запоминая в карту (по ключу комбинации) индексы строк или собирая значения сразу, как нужно. Осуществляем это обновление по кнопке или событию. Оно может быть как синхронизировано с п.1, так и нет (зависит от логики задачи). 3. Выгружаем на лист калькуляции где и когда это нужно. Если нужен вариант через функцию листа, то в функции просто извлекаем необходимое из карты и отображаем на листе.
В принципе, этого должно хватить для абсолютного большинства всех случаев. Как (и, если) понадобиться переосмыслить подход — вернусь к теме.
bedvit, ещё раз огромное спасибо за библу (в целом) и фильтр (в частности)!
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄