loadsort2 with binary search for insert point
Code: (Select All)
Option _Explicit
$Console:Only
_Title "LoadSort2 Demo" ' fixed 2024-04-29
Randomize Timer
Dim insert$, i
ReDim dat$(1 To 1)
Do
Read insert$
If insert$ <> "EOD" Then
loadSort2 insert$, dat$()
'For i = 1 To UBound(dat$)
' Print dat$(i); " ";
'Next
'Print
Else
Exit Do
End If
Loop
For i = LBound(dat$) To UBound(dat$)
Print dat$(i); " ";
Next
Print
Print "press any for number load and sort, zzz..."
Sleep
Dim start#, theTime#
start# = Timer(.001)
ReDim dat$(1 To 1)
i = 1
While i <= 20000
loadSort2 Right$(Space$(6) + Str$(Int(Rnd * 20000)), 6), dat$()
i = i + 1
Wend
theTime# = Timer(.001) - start#
For i = 1 To 20000
Print dat$(i);
Next
Print "20000 random numbers created, loaded and sorted Time:"; theTime#
Data dog,cat,rabbit,frog,horse,dog,mouse,pig,cat,bat,cat,dog,bird,fish,cat,pig,dog,EOD
'this requires a separate dynamic array (used redim instead of dim) to load and sort array
Sub loadSort (insertN As String, dynArr() As String) ' version 2024-04-29
'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
Dim ub, j, k
ub = UBound(dynArr)
If LBound(dynarr) = ub And dynArr(ub) = "" Then ' array not started yet
dynArr(ub) = insertN
Else
ReDim _Preserve dynArr(LBound(dynArr) To ub + 1) As String
For j = 1 To ub
If insertN < dynArr(j) Then ' GT to LT according to descending or ascending sort
For k = ub + 1 To j + 1 Step -1
dynArr(k) = dynArr(k - 1)
Next
Exit For
End If
Next
dynArr(j) = insertN
End If
End Sub
Sub loadSort2 (insertN As String, dynArr() As String) ' version 2024-04-29
'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
Dim As Long lb, ub, j, lo, hi, test, ins, i
lb = LBound(dynArr)
ub = UBound(dynArr)
If lb = ub And dynArr(ub) = "" Then ' array not started yet
dynArr(ub) = insertN
Else
ub = ub + 1
ReDim _Preserve dynArr(lb To ub) As String
If insertN >= dynArr(ub - 1) Then
dynArr(ub) = insertN
ElseIf insertN <= dynArr(1) Then
j = ub
While j >= lb + 1
dynArr(j) = dynArr(j - 1)
j = j - 1
Wend
dynArr(lb) = insertN
Else
lo = lb: hi = ub
While lo <= hi
test = Int((lo + hi) / 2)
If dynArr(test) = insertN Then
j = ub
While j >= test + 1
dynArr(j) = dynArr(j - 1)
j = j - 1
Wend
dynArr(test) = insertN
Exit Sub
Else
If dynArr(test) < insertN Then lo = test + 1 Else hi = test - 1
End If
Wend
For i = test To test + 1
If insertN < dynArr(i) Then ins = i: Exit For
Next
j = ub
While j >= ins + 1
dynArr(j) = dynArr(j - 1)
j = j - 1
Wend
dynArr(ins) = insertN
End If
End If
End Sub
b = b + ...