PureBasic Forums - English

Code: Select all

;Binary insertion of new elements in sorted List. Non recursive.
; by Einander - december 27-2003 - Pb 3.81
;Instead of sorting the list, each element is added on place by binary search
;Allow or avoid repeated values.
;Improvements welcomed!

Global Min,AllowRepeated
AllowRepeated=1     ; <============ zero to avoid repeated values, nonzero to allow
NewList Sorted.l()

Procedure BinSearch(A, Z, key)    
    While (A <= Z)
        Median = (A + Z) / 2
        SelectElement(Sorted(), Median)
        If key > Sorted()
            R = 0 : A = Median + 1
        ElseIf key < Sorted()
            R = -1 : Z = Median - 1 ;
        Else
            ProcedureReturn Median
        EndIf
    Wend
    ProcedureReturn - (Median + R)  ; return negative = non existent element
EndProcedure

Procedure ShowList()
    ResetList(Sorted())
    While NextElement(Sorted())
        Debug Str(n) + "  " + Str(Sorted())
        n + 1
    Wend
EndProcedure

Procedure NewElement(Insert)     ;            add new element in sorted list
    Size=CountList(Sorted())          
    If Size
        SelectElement(Sorted(), Size)                                                   
        If Sorted() < Insert                                                                      
            Swp = Sorted() ;                                         value of last element                                   
            InsertElement(Sorted()) : Sorted() = Swp ;        assign value to the new element
            SelectElement(Sorted(), CountList(Sorted())) ; select last
            Sorted() = Insert ;                                      insert new value in last element 
         ElseIf Insert <= Min ;                         new value to add on the list
            SelectElement(Sorted(), 0)
            If Sorted() <> Insert ;                               if new value is not on the list
                InsertElement(Sorted()) :Sorted() = Insert
                Min = Insert  ;                               new minimum
            EndIf
        Else  
            X = BinSearch(0, Size, Insert)
             If X <= 0 Or AllowRepeated;                             0 or negative values =  new value on the list
                SelectElement(Sorted(), Abs(X) + 1)
                InsertElement (Sorted()) : Sorted() = Insert
            EndIf
        EndIf
    Else   ;                                               only for the first element
        AddElement(Sorted()) : Sorted() = insert     ; new element is the minimumm (and only)
        Min=Insert
    EndIf
EndProcedure
;____________________________________________
;;;;;;TEST  - add random elements
OpenWindow(0, x,y,500,60, #WS_OVERLAPPEDWINDOW | #PB_Window_WindowCentered, "Binary insert in sorted list")
StartDrawing(WindowOutput())

Elements=1200 :Value= 100    ; allow from 0 to Value 
 Locate(10,10): DrawText("Comparing, sorting and adding "+Str(Elements)+" elements - Values 0 to "+Str(Value))
For i=0 To Elements
    NewElement(Random(Value))  ;        choose any value for random
    If i % 2000=0
        Locate(10,30): DrawText(Str(i))
    EndIf
Next 
CloseWindow(0)
ShowList()
  Repeat
       Event = WaitWindowEvent()
  Until Event= #PB_Event_CloseWindow  
End  
  

Code: Select all

NewList M.s() 
Procedure InSortL(A.s(),A,Z,TARGET.s,Rep=0)  ;  insert element Target.s in lista A.s(), sorting down 
    ;  Rep =1 admit  repeateds
    If CountList(A())=0
        AddElement(A()):A()=TARGET
        ProcedureReturn
    Else 
        SelectElement(A(),0)
        If A()>TARGET
            InsertElement(A()): A()=TARGET:ProcedureReturn
        Else
            LastElement(A())
            S2.s=A()      
            If S2<TARGET
                AddElement(A()): A()=TARGET
                ProcedureReturn
            EndIf
        EndIf
    EndIf
    Repeat                        
        Median = (A+Z)/ 2
        SelectElement(A(),Median):S1.s=A()
        SelectElement(A(),Median+1):S2.s=A()
        If Rep=0  
            If S1=TARGET Or S2=TARGET
                ProcedureReturn
            EndIf
        EndIf
        
        If S1<=TARGET And S2>=TARGET
            SelectElement(A(),Median)
            AddElement(A()):A()=TARGET
            ProcedureReturn
        ElseIf TARGET < S1
            Z=Median
        ElseIf TARGET>S1
            A=Median+1
        EndIf
    ForEver
EndProcedure


For i=0 To 100
    r=Random(25)+65
    a$= Chr(r)
  M$=RSet(a$, 10,a$)
    InSortL(M(),0,CountList(M()),M$,1)
Next

ForEach(M())
    n+1
    Debug Str(n)+"  "+M()
Next

Code: Select all

Procedure InsertSortedL(A.l(), val.l) ; inserts an element into an already sorted list at sorted position
  ForEach A()
    If A() >= val
      InsertElement(A())
      A() = val
      ; we found a valid position for inserting, so we can return
      ProcedureReturn
    EndIf
  Next
  ; this is the biggest element, so add it to the end (current position)
  AddElement(A())
  A() = val
EndProcedure