Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Binary Search of an array

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Binary Search of an array

    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.

    Code:
    $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
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com

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

    Code:
    #if 0
    '  binary array search
    '  reference: http://www.powerbasic.com/support/pb...ad.php?t=20054 
    '  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
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com

    Comment

    Working...
    X