Array Binary Search Macro

[Theo Gottwald]

SD made a correction, didn't need item count.

Code Select Expand

#If Not %Def(%ArrayBinarySearchMacro230629)
    %ArrayBinarySearchMacro230629 = 1
    'Binary Search Macro
    'array must be sorted
    'return index if found
    'return one less than LBound(ARR) if not found
    'should work for any number type or string type array
    'Public domain, use at own risk. SDurham
    Macro Function ArrayBinarySearchMacro(ARR,VALUE)
        MacroTemp x, i, top, bot
        Register i As Long
        Local x, top, bot As Long
        top = UBound(ARR)
        bot = LBound(ARR)
        x = bot - 1
        While top >= bot
            i = bot + top
            Shift Right i, 1 'divide by 2
            If VALUE > ARR(i) Then
                bot = i + 1
            ElseIf VALUE < ARR(i) Then
                top = i - 1
            Else
                x = i : Exit Loop
            End If
        Wend
    End Macro = x
#EndIf '%ArrayBinarySearchMacro230629�



Test-Code:

Code Select Expand

'Public domain, use at own risk. SDurham
#Option LargeMem32
#Compile Exe
#Dim All

#Include Once "BinarySearch230629.inc"

Function PBMain() As Long

    Local f As AppendingFile230508I : f = Class "AppendingFile230508C"
    f.Open(Exe.Path$ + Exe.Name$ + ".txt", 1)

    Local a() As Long
    Local value, index As Long

    ReDim a(1 To 5)
    a(1) = 2
    a(2) = 4
    a(3) = 6
    a(4) = 8
    a(5) = 10
    Array Sort a()

    For value = 1 To 12
        index = ArrayBinarySearchMacro(a,value)
        f.Add = "value = " + Format$(value) +" : "+  "index = " + Format$(index)
    Next value

    f.Add = ""
    f.Add = ""

    f.Close()
    Sleep 1
    f.Notepad()
End Function

Class AppendingFile230508C
    Instance myFile As WString
    Instance myFileNo As Long
    Class Method Destroy()
        If myFileNo Then Close myFileNo
    End Method
    Interface AppendingFile230508I : Inherit IUnknown
        Method Open(ByVal file As WString, Opt ByVal killFile As Byte)
            'open file : optionally kill previous instance
            If Len(file) Then
                If killFile Then Kill file
                myFileNo = FreeFile
                If myFileNo Then
                    myFile = file
                    Open myFile For Append As myFileNo
                End If
            End If
        End Method
        Property Set Add(ByVal value As WString)
            'append value to file
            Print# myFileNo, ChrToUtf8$(value)
        End Property
        Method Close()
            'close file
            If myFileNo Then
                Close myFileNo
                myFileNo = 0
            End If
        End Method
        Method Notepad()
            'open file with Notepad
            Local hprocess&
            hprocess& = Shell("notepad.exe " + myFile, 1)
        End Method
    End Interface
End Class�