Tweet
I posted this in the Source Code forum, but wanted to discuss it here.
I needed a binary search and was surprised that despite lots of hits on the search term, the actual code examples were far fewer.
Perhaps that's because it's thought to be so simple? But despite the relatively few lines of code in the result, I managed to spend far more time than I expected to get the final code (I won't admit how much time!).
So, my next step would be to speed it up even more. But I knew that if I posted the code, someone would say "Hey, I did this back in '85 and it still works - better than that turtle code Gary posted!"
One more thing - in cases where the search term was not found, I want to know where the search term "would have" been. It lets me get suggested terms when I use the binary search in spell check code.
And here's a compilable example.
I needed a binary search and was surprised that despite lots of hits on the search term, the actual code examples were far fewer.
Perhaps that's because it's thought to be so simple? But despite the relatively few lines of code in the result, I managed to spend far more time than I expected to get the final code (I won't admit how much time!).
So, my next step would be to speed it up even more. But I knew that if I posted the code, someone would say "Hey, I did this back in '85 and it still works - better than that turtle code Gary posted!"
One more thing - in cases where the search term was not found, I want to know where the search term "would have" been. It lets me get suggested terms when I use the binary search in spell check code.
Code:
Function BinaryWordSearch(sWord As String, iPos&) As Long
'search for sWord$ in WordList(), which is a Global array
'return 1 if found, 0 otherwise
'iPos& is UBound(WordList) + 1 if searchterm > all values in array
'iPos& is -1 if searchterm < all values in array
'otherwise, iPos is position found, or position where search term should have been found (immediately below 1st item greater)
Local Upper As Long, Lower As Long
Lower = LBound(WordList) : Upper = UBound(WordList)
'test boundary values
If sWord = WordList(Lower) Then iPos& = Lower : Function = 1 : Exit Function
If sWord = WordList(Upper) Then iPos& = Upper : Function = 1 : Exit Function
If sWord < WordList(Lower) Then iPos& = Lower - 1 : Function = 0 : Exit Function
If sWord > WordList(Upper) Then iPos& = Upper + 1 : Function = 0 : Exit Function
Do Until (Upper <= (Lower+1))
iPos& = (Lower + Upper) / 2
Select Case sWord
Case > WordList(iPos&) : Lower = iPos&
Case < WordList(iPos&) : Upper = iPos&
Case WordList(iPos&) : Function = 1 : Exit Function
End Select
Loop
End Function
Code:
'Compilable Example:
'This example declares sWord as STRING, search for a match in a sorted string array.
'Also, be aware that in code such as this, which uses the greater than or less than
'symbols, that string comparisons are being made and that "0600" will come after "06"
'(the numeric values of 600 and 6 are NOT used to make the comparison).
#Compile Exe
#Dim All
#Include "Win32API.inc"
Global hDlg as Dword, WordList() As String
Function PBMain() As Long
Local i As Long
ReDim WordList(1000)
For i = 0 to 700 : WordList(i) = Format$(i,"00000") : Next i 'these two lines leave out "00701"
For i = 701 to 1000 : WordList(i) = Format$(i+1,"00000") : Next i
Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Search", 50,10,100,20
Control Add TextBox, hDlg, 200,"00000", 50,35,100,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
Local sWord$, iPos&, i As Long
Control Get Text hDlg, 200 To sWord$
If BinaryWordSearch(sWord$, iPos&) Then
MsgBox sWord$ + " was found at array position " + Str$(iPos&) + "."
Else
MsgBox sWord$ + " was not found. It should have been at position " + Str$(iPos&) + "."
End If
If LinearWordSearch(sWord$, iPos&) Then
MsgBox sWord$ + " was found at array position " + Str$(iPos&) + "."
Else
MsgBox sWord$ + " was not found. It should have been at position " + Str$(iPos&) + "."
End If
SpeedTest sWord$
End If
End Function
Function BinaryWordSearch(sWord As String, iPos&) As Long
'search for sWord$ in WordList(), which is a Global array
'return 1 if found, 0 otherwise
'iPos& is UBound(WordList) + 1 if searchterm > all values in array
'iPos& is -1 if searchterm < all values in array
'otherwise, iPos is position found, or position where search term should have been found (immediately below 1st item greater)
Local Upper As Long, Lower As Long
Lower = LBound(WordList) : Upper = UBound(WordList)
'test boundary values
If sWord = WordList(Lower) Then iPos& = Lower : Function = 1 : Exit Function
If sWord = WordList(Upper) Then iPos& = Upper : Function = 1 : Exit Function
If sWord < WordList(Lower) Then iPos& = Lower - 1 : Function = 0 : Exit Function
If sWord > WordList(Upper) Then iPos& = Upper + 1 : Function = 0 : Exit Function
Do Until (Upper <= (Lower+1))
iPos& = (Lower + Upper) / 2
Select Case sWord
Case > WordList(iPos&) : Lower = iPos&
Case < WordList(iPos&) : Upper = iPos&
Case WordList(iPos&) : Function = 1 : Exit Function
End Select
Loop
End Function
Function LinearWordSearch(sWord As String, iPos&) As Long
'search for sWord$ in WordList(), which is a Global array
'return 1 if found, 0 otherwise
'iPos& is UBound(WordList) + 1 if searchterm > all values in array
'iPos& is -1 if searchterm < all values in array
'otherwise, iPos is position found, or position where search term should have been found (immediately below 1st item greater)
Local i As Long
For i = 0 to UBound(WordList)
Select Case sWord
Case > WordList(i) 'no action, keep looping
Case < WordList(i) : iPos& = i - 1 : Function = 0 : Exit Function
Case WordList(i) : iPos& = i : Function = 1 : Exit Function
End Select
Next i
iPos& = i
End Function
Sub SpeedTest (sWord As String)
'speed test - Binary
Dim iStart As Long, iEnd As Long, i As Long, iPos&
iStart = GetTickCount
For i = 1 To 10000 : BinaryWordSearch(sWord,iPos&) : Next i
iEnd = GetTickCount
MsgBox "Binary: " + Format$((iEnd - iStart)/1000,3) & " seconds"
'speed test - Linear
iStart = GetTickCount
For i = 1 To 10000 : LinearWordSearch(sWord,iPos&) : Next i
iEnd = GetTickCount
MsgBox "Linear: " + Format$((iEnd - iStart)/1000,3) & " seconds"
End Sub
'gbs_00396
Comment