Страницы: 1
RSS
Двоичный поиск VBA в отсортированном двумерном массиве с набором вспомогательных процедур
 
Возможно кому пригодится...
Понравилось время поиска - таймер так и остается нулевым даже на массиве в 1кк.
Параметры (arr(), ByVal n%, ff, ByVal ll&, ByVal hh&, Optional S As Boolean = True):
- исходный массив в котором ищем
- номер столбца (если уместна такая аналогия с листом Excel)
- искомое значение (тип Variant и по ссылке, поэтому нужно быть осторожным). по результатам поиска в него возвращается позиция элемента или -1, если элемент не был найден
- верхняя граница поиска
- нижняя граница поиска
- нужно ли массив предварительно сортировать (True - да, False - нет)

Поисковик:
Скрытый текст

Вспомогательные процедуры:
Скрытый текст

Тестер + функция для генерации строк:
Скрытый текст

Результаты теста по времени:
Скрытый текст
 
Anchoret, приветствую!))
Хочу использовать ваш вариант бинарного поиска в отсортированном массиве. Есть вопросы:
1. ll  - это, наверное НИЖНЯЯ граница, а hh — ВЕРХНЯЯ границы?
2. ll = LBound(arr,1), а hh = UBound(arr,1), если массив берётся с листа?
3. я же могу смело прикрутить сортер из #155 вместо "штатного"?
Изменено: Jack Famous - 26.03.2019 10:36:11
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous,
1. Да
2. Если и не с листа тоже, или просто L/Ubound(arr)
3. Если там прячется сортер чисел или текста в чистом виде, то да. Клевер все еще не готов. А времени исправить это все еще нет)
 
Anchoret, благодарю!
1. тогда у вас в описании ошибка
2. да - первое измерение можно упускать, но в двумерном я указываю, чтобы подчеркнуть наличие "второго" (привычка)  :)
3. там функция на основе обновлённого вами текстового сортера (гляньте по ссылке)
Изменено: Jack Famous - 26.03.2019 12:21:51
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, тут как в космосе - верх и низ относительные понятия) Если от начала нумерации, то низ. Если представить двумерный массив в виде таблицы, то верх.
 
Anchoret, я всё сделал и всё отлично и супербыстро работает  :idea: Спасибо Вам большое!
Изменил под себя и оформил в функцию
Изменено: Jack Famous - 26.03.2019 14:28:53
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, там на самом деле довольно простенький алгоритм заложен:
- выбирается примерный центр массива, где проводится поиск
- если искомый элемент меньше элемента в выбранном участке массива, берем нижнюю (ту, что с меньше по нумерации индексов) часть массива и снова делим ее надвое
- если больше, то делим верхнюю
- ну и так далее, пока диапазон не сокращается до 10 индексов, и тут циклом проверяем

П.С.: Этот поисковик встроен в пользовательский вариант Dictionary, именно поэтому там сортируется все и вся.
Изменено: Anchoret - 26.03.2019 14:05:23
 
Цитата
Anchoret: алгоритм
собственно, это и есть классический бинарный поиск в эффективной и понятной "оболочке"

P.S.: под ваш словарь только всё готовлю и размышляю)))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
написал:
Возможно кому пригодится...
Дополнил алгоритм для поиска ближайших значений (в отсортированном по колонке поиска одномерном массиве).
Может пригодиться..
Может искать точное вхождение и возвращать -1, если не найдено.
Может искать ближайшее меньшее, или большее, если не найдено точно - см. параметр Eq
Код
' бинарный ускоренный поиск в массиве - возвращает индекс или -1
Public Function BSearchDbl&(arr, ByVal elm As Double, Optional Eq As Integer = 0)
    'Бинарный поиск
    ' Eq = 0 точный поиск, -1 - ближайшее меньшее значение, -2 ближайшее меньшее или первое (без ERROR) 1 - ближайшее большее, 2 - ближайшее большее или последнее (без ERROR)
    Dim max&, min&, tmp&
    min = LBound(arr)
    max = UBound(arr)
    While min <= max
        BSearchDbl = (min + max) \ 2
        If elm < arr(BSearchDbl) Then
            max = BSearchDbl - 1
        ElseIf elm = arr(BSearchDbl) Then
            Exit Function
        ElseIf elm > arr(BSearchDbl) Then
            min = BSearchDbl + 1
        End If
        tmp = tmp + 1
        If min > max And Eq <> 0 Then
            If Eq < 0 Then
                BSearchDbl = max
            Else
                BSearchDbl = min
            End If
            If Eq = -2 And BSearchDbl < LBound(arr) Then
                BSearchDbl = LBound(arr)
            ElseIf Eq = 2 And BSearchDbl > UBound(arr) Then
                BSearchDbl = UBound(arr)
            End If
            Exit Function
        End If
    Wend
    BSearchDbl = -1
End Function

Sub test()
    x = Array(1, 2, 4, 10)
    y = BSearchDbl(x, 3, -2)
    Debug.Print x(y)
End Sub

Так же пример для двухмерного массива
Код
' бинарный ускоренный поиск в массиве - возвращает индекс или -1
Public Function BSearchDbl&(arr, ByVal elm As Double, Optional Col As Integer = 0, Optional WhereCol As Integer = 2, Optional Eq As Integer = 0, Optional ByVal FromRow As Long = -1, Optional ByVal ToRow As Long = -1)
    'Бинарный поиск Col - номер колонки поиска, либо 0, если одномерный массив, WhereCol = 1 или 2 - расположение размерности колонок (часто 2, но кто redim массивы расширяет, у них колонки в 1)
    ' Eq = 0 точный поиск, -1 - ближайшее меньшее значение, -2 ближайшее меньшее или первое (без ERROR) 1 - ближайшее большее, 2 - ближайшее большее или последнее (без ERROR)
    Dim max&, min&, tmp&
    If FromRow = -1 Then FromRow = LBound(arr)
    If ToRow = -1 Then ToRow = UBound(arr)
    min = FromRow
    max = ToRow
    
    While min <= max
        BSearchDbl = (min + max) \ 2
        If Col > 0 And WhereCol = 1 Then
            If elm < arr(Col, BSearchDbl) Then
                max = BSearchDbl - 1
            ElseIf elm = arr(Col, BSearchDbl) Then
                Exit Function
            ElseIf elm > arr(Col, BSearchDbl) Then
                min = BSearchDbl + 1
            End If
        ElseIf Col > 0 And WhereCol = 2 Then
            If elm < arr(BSearchDbl, Col) Then
                max = BSearchDbl - 1
            ElseIf elm = arr(BSearchDbl, Col) Then
                Exit Function
            ElseIf elm > arr(BSearchDbl, Col) Then
                min = BSearchDbl + 1
            End If
        Else
            If elm < arr(BSearchDbl) Then
                max = BSearchDbl - 1
            ElseIf elm = arr(BSearchDbl) Then
                Exit Function
            ElseIf elm > arr(BSearchDbl) Then
                min = BSearchDbl + 1
            End If
        End If
        tmp = tmp + 1
        If min > max And Eq <> 0 Then
            If Eq < 0 Then
                BSearchDbl = max
            Else
                BSearchDbl = min
            End If
            If Eq = -2 And BSearchDbl < FromRow Then
                BSearchDbl = FromRow
            ElseIf Eq = 2 And BSearchDbl > ToRow Then
                BSearchDbl = ToRow
            End If
            Exit Function
        End If
    Wend
    BSearchDbl = -1
End Function

Пример вызова

PairsInHistoryPos = BSearchDbl(arr:=Массив где ищем, elm:=Что ищем, Col:=Колонка поиска, WhereCol:=Расположение колонок в 2D, Eq:=-2, FromRow:=С какой строки ищем, ToRow:=По какую строку ищем)
Страницы: 1
Наверх