Search (Binary)

Category: Arrays

Date: 03-28-2012

Return to Index


 
'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:
'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
#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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm