PureBasic Forums - English

Code: Select all

;
;  BinarySearch
;  C Like
;
;  (C) T. Agius 2007
;  For free use and distribution

#ELEMENTS   = 50
#TESTSEARCH = 20

Structure   stInfo
   Name.s
   desc.s
   id.l
EndStructure

Global Dim        Test.stInfo(#ELEMENTS + 1)
Global Dim        rstr.s(100)

Procedure           CompName ( *s1, *s2 )
   ProcedureReturn CompareMemoryString ( PeekL ( *s1 ), *s2, 1 )
EndProcedure

Procedure.l         BinarySearch ( arr.l, var.l, Size.l, start.l, ends.l, compfun.l )

  Protected         i.l, j.l, k.l
  Protected         m.l, n.l
  
  n = -1
    
  Repeat
  
      i = ends - start
      j = (i)  >> 1
      j + start
      ;Debug "BS> "+ Str (j) + " with total elements of " + Str (i) + " from " + Str (start) + " to " + Str (ends)
      k = arr + ( j * Size )
      m = CallFunctionFast ( compfun, k, var )      
        
      If m = 0
        ProcedureReturn j
      EndIf
      
      If n <> j
        If m < 0        
            start = j + 1            
        Else
            ends = j - 1
        EndIf
        n = j
      Else        
        ProcedureReturn -1
      EndIf
      
  Until start > ends
    
  ProcedureReturn -1
    
EndProcedure

   Define.l     i, j, k, l
   Define.l     find, found
   Define.l     maxs
   Define.s     temp
   
   Restore Rstrings
   maxs = 0
   
   Repeat  
      Read rstr ( maxs )
      maxs + 1
   Until maxs > 40
   
   maxs - 1
      
   For i = 0 To #ELEMENTS
      Test(i)\id     = Random ( 50000 )
      j = Random ( maxs )
      
      ;Debug "Write to "+ Str ( i ) + " from " + Str ( j )
      Test(i)\Name = rstr ( j )      
      k = Random ( 3 )
      temp = ""
      l = 0
      
      Repeat
        temp + rstr ( Random ( maxs ) ) + " "
        l + 1
      Until l > k
            
      Test(i)\desc   = temp      
   Next
   
      
   SortStructuredArray ( Test(), 2, OffsetOf ( stInfo\Name ), #PB_Sort_String, 0, #ELEMENTS )
   
   For i = 0 To #ELEMENTS
      Debug ">" + Str ( i ) + " - " + Str ( Test(i)\id ) + " " + Test(i)\Name + " " + Test(i)\desc
   Next i 
   
   For i = 0 To #TESTSEARCH
       If i % 3
        find = @rstr ( Random ( maxs ) )
       Else
        find = @Test ( Random ( #ELEMENTS )) \Name
       EndIf
        
       found = BinarySearch ( @Test(), find, SizeOf (stInfo), 0,#ELEMENTS, @CompName() )
       
       If found >= 0
          Debug "Look for [" + PeekS (find) + "] found [" + Test(found)\Name + "] at position [" + Str ( found ) + "]"
       Else
          Debug "[" + PeekS( find ) + "] Not Found!...Verifying"
          
          For j = 0 To #ELEMENTS
            If CompareMemoryString ( find, @Test(j)\Name, 1 ) = 0
                Debug "OOPS! brutal force search found at position [" + Str ( j )+ "]"
                Break
            EndIf          
          Next

       EndIf
   Next


End

DataSection

Rstrings:

    Data$   "Monica Ricci"
    Data$   "Chuck Yeager"
    Data$   "Stalin & Hitler"
    Data$   "Terence Agius"
    Data$   "UEFA League"
    Data$   "Peter Ustinov"
    Data$   "Fred Flintstone"
    Data$   "Pasta Barilla"
    Data$   "Gaya Patal"
    Data$   "Olivia del Rio"
    Data$   "Canasta"
    Data$   "Roger Rabbit"
    Data$   "Isaac Asimov"
    Data$   "Lucky Strike"
    Data$   "Shell Oil"
    Data$   "Natura Gas"
    Data$   "Whodonit"
    Data$   "Sherlock Holmes"
    Data$   "Microsoft"
    Data$   "Beast Boy"
    Data$   "Robin Hood"
    Data$   "Underwear Corp"
    Data$   "Team Titans"
    Data$   "Duffy Duck"
    Data$   "Space Shuttle"
    Data$   "Knights of Malta"
    Data$   "King Lear"
    Data$   "Helicopter"
    Data$   "Hogar the Terrible"
    Data$   "Pizza 4 Seasons"
    Data$   "Jump Jets"
    Data$   "Roast Chicken"
    Data$   "HP Notebooks"
    Data$   "Flamer"
    Data$   "Radio Control"
    Data$   "Burgher King"
    Data$   "Helsinki"
    Data$   "Jester"
    Data$   "McDonalds"
    Data$   "Venezia"
    Data$   "Calligula"    

EndDataSection

Code: Select all

;===============================================
; Program:     BINARY SEARCH of structures, using replaceable comparison function 
; Version:     1.0
; Date:        6 November 2007
; Author:      Demivec (J.Johnson)
; Compiler:    PureBasic 4.02 for Windows.
; Licence:     Free to use and distribute with or without crediting author
;===============================================



Prototype.l comparisonFunction(*element_1,*element_2)

Procedure compString(*s1,*s2)
  ProcedureReturn CompareMemoryString(PeekL(*s1),*s2,1)
EndProcedure

Procedure compLong(*long1,*long2) ;returns values are (-1,0,1) for (<,=,>)
  If PeekL(*long1)>PeekL(*long2) 
    ProcedureReturn 1
  ElseIf PeekL(*long1)<PeekL(*long2)
    ProcedureReturn -1
  Else 
    ProcedureReturn 0
  EndIf
EndProcedure

;*table = address of element at index 0,Size = size of structure
;*find = address of element ot match
;lowestIndex,highestIndex = range to search
;examine = Address of comparison function (function returns values of (-1,0,1) if (<,=,>) than *find element
Procedure.l binarySearch(*table.l,*find.l,Size.l,lowestIndex.l,highestIndex.l,examine.comparisonFunction)
  Protected middleIndex.l,result.l
  
  Repeat
    middleIndex =(highestIndex + lowestIndex) >> 1
    result = examine(*table+Size*middleIndex,*find)
    
    If result > 0       
      highestIndex = middleIndex - 1           
    ElseIf result < 0
      lowestIndex = middleIndex + 1
    Else
      ProcedureReturn middleIndex
    EndIf
  Until lowestIndex > highestIndex
  
  ProcedureReturn -1 ;not present
EndProcedure