Binary Search of an array

[Michael Mattias]

Here is an example of a binary array search, originally written for PB/DOS v 3.2 and only recently run under PB/DOS 3.5

A binary search requires the array to be sorted in key order; and the only "condition" you may search for is "Equal To" (i.e, you cannot use a binary search for "greater than"); this implementation requires that all array subscripts be not less than zero.

To convert to PB/Windows, the INCR and DECR statements in FUNCTION BinaryFind must be changed, as PB/Windows does not support the 'amount' parameter of the PB/DOS "INCR dataname [,amount]" statement.

$IF 0
  4.22.97 File: Bisearch.bas
  Build a binary search with recursive algorithm
  Author: Michael Mattias Racine WI
  Placed in the public domain by the author 2.13.00
  Requires: Sorted array
  4.22.97 all I have is an idea.
  5.10.97 This will be useful as a replacement for ARRAY SCAN, which is
  a sequential search (I think - no it has to be , since it works on
  unsorted arrays!)
  2.13.00  Move to PB 3.5, comment

$ENDIF

$LIB ALL OFF
$ERROR ALL ON
DEFINT A-Z

COLOR 7,1:CLS
MAIN:

FOR K = 100 TO  32000 STEP 499
  IF INKEY$ = CHR$(27) THEN
     PRINT
     PRINT "Aborted.."
     EXIT FOR
  END IF
  LOCATE  5, 10
  PRINT SPACE$(40)
  LOCATE 5,10
  PRINT "ArrayElements=";USING$ ("##,###", K);SPACE$(02); " (Escape Exits)";
  LET NoElements = K
  GOSUB BuildArray
  FOR L = LBOUND (Y()) TO UBOUND(Y())
    Target = L
'    PRINT USING$("####",Target);
    Found = BinaryFind (Y(),Target)
    IF Found <> Target THEN
      PRINT "Failed on Target=";Target;" with elements=";K
      J$=INPUT$(01)
      IF J$=CHR$(27) THEN END
    END IF
  NEXT L
NEXT K

END

BuildArray:
' build a sorted array
REDIM Y(NoElements) AS INTEGER
FOR I = LBOUND (Y) TO UBOUND (Y)
  Y(I) = I
NEXT I
 RETURN


FUNCTION BinaryFind (X() AS INTEGER, T AS INTEGER) AS INTEGER
' Returns: Index of X() where X(n) = T, or -9999 if not found.
' Will not work if array indices are negative.

 LOCAL I&, Interval%

     ON LOCAL ERROR GOTO BiSearchError
     IF T > X(UBOUND(X())) OR T < X(LBOUND (X())) THEN FUNCTION = -9999: EXIT FUNCTION
     Let I& = (UBOUND (X) - LBOUND(X) + 1) \ 2
     Let Interval% = I&  \ 2    ' first pass
     DO
        IF X(I&) = T THEN
           FUNCTION=CINT(I&)
           EXIT FUNCTION
        END IF
        Interval% = Interval% \ 2 + Interval% MOD 2
        IF X(I&) > T THEN
          DECR I&, Interval%
        ELSE
          INCR I&, Interval%
        END IF
     LOOP UNTIL Interval% = 0
     FUNCTION = -9999
     PRINT "NotFound"
BiSearchResume:
     EXIT FUNCTION

BiSearchError:
  PRINT "Error";ERR;" when elements="UBOUND(X())" and target="T" and I&="I&
  J$=INPUT$(01)
  RESUME BiSearchResume
END FUNCTION

-------------
Michael Mattias
Racine WI USA
[email protected]

[Michael Mattias]

update for pb/win and improved algorithm, also added test code

#if 0
'  binary array search
'  reference: [url="http://www.powerbasic.com/support/pbforums/showthread.php?t=20054"]http://www.powerbasic.com/support/pbforums/showthread.php?t=20054[/url] 
'  courtesy ian cairns, july 2003. mr cairns offers credit to mr. ethan winer
'  but no reference to source of code available.
'  modified by michael mattias to convert to true-false function
'  public domain
'  compiler used: pb/win v 7.02
#endif

#compile exe
#dim all
#register none
#tools off

'
' ------------------------------------------------------------------------
' search an array of dynamic strings for presence of a string value
' function to tell us if a certain key was found in a array of keys
'     returns: 0  = notfound
'     non-zero: found searchfor in x()
' requires x() array be sorted ascending
' -----------------------------------------------------------------------
function binaryfindstring (x() as string, searchfor as string) as long

  local testpos as long, firstelement as long, lastelement as long
  local foundit as long

  foundit      =   0
  firstelement = lbound(x,1)
  lastelement  = ubound(x,1)

  do
      testpos  = (firstelement + lastelement) \ 2
      if x(testpos) = searchfor then
          foundit   = 1
          exit do
      end if
      if x(testpos) > searchfor then
          lastelement = testpos - 1
      else
          firstelement = testpos + 1
      end if
  loop while lastelement >= firstelement

  function = foundit

end function

' ======= winmain to test both performance and accuracy ==============='

' accuracy tests:   odd number  of array elements
'                   even number of array elements
'  search target at start of array
'  search target at end of array
'  search target greater highlest value in array
'         target less lowest value in array
' speed tests: all known found, all known not found
' ====================================================

%num_elements  =  9999   ' start small  works ok at both 1000 and 100,000!
%element_size  =   12

function sformatstring (byval z as long) as string

    function = rset$(format$(z, "#########"), %element_size)

end function

function pbmain () as long

    local i as long, j as long, k as long

    ' build random data pool
    redim  datapool(%num_elements) as long
    call   builddatapool (datapool())
    ' build tag array:
    redim  tag(%num_elements)   as long
    for i = 0 to %num_elements
        tag(i)  = i
    next
    ' build string array to serve as search table
    redim searchtable(%num_elements) as string
    for i = 0 to %num_elements
        searchtable (i) = sformatstring (datapool(i))
    next
    ' sort the search table ascending (req'd for binary search), bring along tag array
    ' in case we want to do something with the data..
    array sort searchtable(), tagarray tag()

    call accuracytest (datapool(), searchtable(), tag())

    call speedtest         (datapool(), searchtable(), tag())
    call speedtestnotfound (datapool(), searchtable(), tag())


end function

function speedtest (datapool() as long, searchtable() as string, tag() as long) as long

    local i as long, searchfor as string, hit as long
    redim starttime(1) as single, endtime(1) as single, difftime(1) as single

    ' test one: linear search using array scan
    starttime(0) = timer
    for i = 0 to %num_elements
        array scan searchtable(),=searchtable(i), to hit
        if isfalse hit then
            msgbox "no hit, not possible",,"array scan"
            exit for
        end if
    next
    if istrue hit then
        endtime(0) = timer
    else
        exit function
    end if

    ' test two: using binary search
    starttime(1) = timer
    for i = 0 to %num_elements
        hit = binaryfindstring(searchtable(), searchtable(i))
        if isfalse hit then
            msgbox "no hit, not possible",,"binary find"
            exit for
        end if
    next
    if istrue hit then
        endtime(1) = timer
    else
        exit function
    end if

    ' if still here no errors, get times
    difftime(0) = endtime(0) - starttime(0)
    difftime(1) = endtime(1) - starttime(1)

   msgbox "array scan" & str$(difftime(0)) _
          & $crlf & "binary search" & str$(difftime(1)),,str$(%num_elements)

end function
' search  table with for item we will never find (this is worst case for both)
function speedtestnotfound (datapool() as long, searchtable() as string, tag() as long) as long

    local i as long, searchfor as string, hit as long
    redim starttime(1) as single, endtime(1) as single, difftime(1) as single

    msgbox "enter speedtestnotfound"

    searchfor = "test me"   ' << will not be found

    ' test one: linear search using array scan
    starttime(0) = timer
    for i = 0 to %num_elements
        array scan searchtable(),=searchfor, to hit
        if istrue hit then
            msgbox "hit, not possible",,"array scan"
            exit for
        end if
    next
    if isfalse hit then
        endtime(0) = timer
    else
        exit function
    end if

    ' test two: using binary search
    starttime(1) = timer
    for i = 0 to %num_elements
        hit = binaryfindstring(searchtable(), searchfor)
        if istrue hit then
            msgbox "hit, not possible",,"binary find"
            exit for
        end if
    next
    if isfalse hit then
        endtime(1) = timer
    else
        exit function
    end if

    ' if still here no errors, get times
    difftime(0) = endtime(0) - starttime(0)
    difftime(1) = endtime(1) - starttime(1)

   msgbox "array scan" & str$(difftime(0)) _
          & $crlf & "binary search" & str$(difftime(1)),,str$(%num_elements)

end function

function accuracytest (datapool() as long, searchtable() as string, tag() as long) as long

    local i as long, searchfor as string, hit as long

    ' first, test that search finds all the strings in the datapool

    for i = 0 to %num_elements
       searchfor = sformatstring(datapool(i))
       hit       = binaryfindstring(searchtable(), searchfor)
       if isfalse hit then
           msgbox "did not find '" & searchfor & "' , datapool element " & str$(i)
           exit for
       end if
    next
    if istrue hit then
        msgbox "found all items in data pool ok"  ' ok this worked
    end if

    ' now try a serires of items not in the data pool
    randomize timer
    for i = 0 to %num_elements
        searchfor = str$(rnd)
        hit       = binaryfindstring (searchtable(), searchfor)
        if istrue hit then
            msgbox "returned found for " & searchfor
            exit for
        end if
    next
    if isfalse hit then
        msgbox "no false positives"  ' also ok..
    end if


end function


function builddatapool (d() as long) as long

    local i as long

    randomize timer
    for i = 0 to %num_elements
        d(i) = rnd(1, 10000)  ' create series of integers in range 1 to 10000
    next
end function

#if 0
 original function as posted - slighlty different parameters and return values
function binarysearch??? (testarray$(), byval firstelement???, byval lastelement???, searchstring$, found%)
  found% = %false  'no matching element yet
  do
    testpos??? = (firstelement???+lastelement???) \ 2 ' start position

    if array$(testpos???) = searchstring$ then   ' done!
      binarysearch??? = testpos???
      found% = %true
      exit do
    end if

    if array$(testpos???) > searchstring$ then   ' search block halved
      lastelement??? = testpos??? - 1
    else
      firstelement??? = testpos??? + 1               'too low, cut other way
    end if
  loop while lastelement??? >= firstelement???
end function
#endif

mcm
7/15/03