Цитата |
---|
написал: Возможно кому пригодится... |
Может пригодиться..
Может искать точное вхождение и возвращать -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:=По какую строку ищем) |