Date: 02-16-2022
Return to Index
created by gbSnippets
'If all you want to do is find the position of a value in an array, then the PowerBASIC
'Array Scan statement will do the trick.
'But sometimes you not only want to know if the value is in the array (and its position),
'but you want to know where the value should have been in the array, if it had been found.
'Knowing where the value should have been located can be useful, for example, in a dictionary
'word search where you want to provide nearby words as suggestions for a mis-spelled word.
'In general, for a single word search a linear search through the array is just fine, but many
'searches or large databases, a binary search is much faster.
'Primary Code:
'This code does the search and returns the position of the search term. If the search term
'is not found, the position of the array where the term "should" have been is returned.
Function BinaryWordSearch_Slower(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
'Define sWord as STRING, Long, SINGLE, or any other data type to modify the
'binary search for the required data type.
'Compilable Example: (Jose Includes)
'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).
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
If sWord > WordList(iPos&) Then
Lower = iPos&
ElseIf sWord < WordList(iPos&) Then
Upper = iPos&
Else
Function = 1 : Exit Function
End If
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)
If sWord < WordList(i) Then
iPos& = i - 1 : Function = 0 : Exit Function
ElseIf sWord = WordList(i) Then
iPos& = i : Function = 1 : Exit Function
End If
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
Function BinaryWordSearch_Slower(sWord As String, iPos&) As Long
'... an earlier version of the binary search ... slower than the one above
'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_Slower(sWord As String, iPos&) As Long
'... an earlier version of the linear search ... slower than the one above
'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
'gbs_00396
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm