This has been changed to best answer as it accomplishes exactly the same thing except even faster. Simplified Binary search code, using \ 2 instead of / 2 and changed IF-ELSE block to SELECT CASE, dropping time at N=16777216 to less than 11s versus a shade over 14s for a roughly 20% increase in performance: The highly edited Binary Search SUB tested on a dataset 8 times bigger than this. The result at this number is even more astounding at nearly 1300 times faster than slowpoke linear search.
SUB BinarySearch (CGSortLibArr() AS _INTEGER64, BinarySearch_Start AS _INTEGER64, BinarySearch_Finish AS _INTEGER64, BinarySearch_SearchTarget AS _INTEGER64, BinarySearch_where AS _INTEGER64, BinarySearch_errorflag AS INTEGER)
BinarySearch_errorflag = 0
'******************** These must be the same numerical type as the variable parameters they hold.
DIM BinarySearch_L AS _INTEGER64: BinarySearch_L = BinarySearch_Start
DIM BinarySearch_C AS _INTEGER64: BinarySearch_C = BinarySearch_Start
DIM BinarySearch_H AS _INTEGER64: BinarySearch_H = BinarySearch_Finish
'********************
DO
BinarySearch_C = BinarySearch_L + (BinarySearch_H - BinarySearch_L) \ 2
SELECT CASE CGSortLibArr(BinarySearch_C)
CASE IS < BinarySearch_SearchTarget
BinarySearch_L = BinarySearch_C + 1
CASE IS > BinarySearch_SearchTarget
BinarySearch_H = BinarySearch_C - 1
CASE ELSE
BinarySearch_where = BinarySearch_C
EXIT SUB
END SELECT
LOOP UNTIL BinarySearch_L > BinarySearch_H
BinarySearch_errorflag = -1
END SUB
'CgBinaryVersusLinearSearch
TYPE range
lower AS _INTEGER64
upper AS _INTEGER64
END TYPE
TYPE ArrayDescript
ArrayBounds AS range
ArraySorted AS range
index AS _INTEGER64
END TYPE
REDIM SearchedArray(0 TO 16777215) AS _INTEGER64
REDIM SearchedArrayD AS ArrayDescript
SearchedArrayD.ArrayBounds.lower = LBOUND(SearchedArray)
SearchedArrayD.ArrayBounds.upper = UBOUND(SearchedArray)
SearchedArrayD.ArraySorted.lower = LBOUND(SearchedArray)
SearchedArrayD.ArraySorted.upper = LBOUND(SearchedArray)
SetArray SearchedArray(), SearchedArrayD, SearchedArrayD.ArrayBounds.lower, SearchedArrayD.ArrayBounds.upper
PRINT "sorting..."; (SearchedArrayD.ArrayBounds.upper - SearchedArrayD.ArrayBounds.lower + 1); TIMER(.001)
QuickSortIterative SearchedArray(), SearchedArrayD.ArrayBounds.lower, SearchedArrayD.ArrayBounds.upper, 0
PRINT "sorted..."; TIMER(.001)
PRINT "PERFORMING SERACH OF ALL ELEMENTS USING BINARY SEARCH"
DIM SearchedArray_where AS _INTEGER64
BinarySearchsTART! = TIMER(.001)
DO
'PRINT SearchedArray(SearchedArrayD.index)
BinarySearch SearchedArray(), SearchedArrayD.ArrayBounds.lower, SearchedArrayD.ArrayBounds.upper, SearchedArray(SearchedArrayD.index), SearchedArray_where, SearchedArray_error
IF SearchedArray_error THEN
STOP
ELSE
SearchedArrayD.index = SearchedArrayD.index + 1
END IF
'IF SearchedArrayD.index MOD 10000 = 0 THEN
' LOCATE , 1
' PRINT SearchedArrayD.index;
'END IF
LOOP UNTIL SearchedArrayD.index > SearchedArrayD.ArrayBounds.upper
BinarySearchFinish! = TIMER(.001)
PRINT
PRINT "Binary Search took "; BinarySearchFinish! - BinarySearchsTART!; " seconds"
SearchedArrayD.index = SearchedArrayD.ArrayBounds.lower
DIM LinearSearchStart!: LinearSearchStart! = TIMER(.001)
DIM LinearSearchfINISH!: LinearSearchfINISH! = LinearSearchStart!
DIM LSI AS _INTEGER64
DIM lSIeRROR AS INTEGER: lSIeRROR = 0
PRINT "Starting linear search until time meets or exceeds time used by Binary Search"
DO
LSI = SearchedArrayD.ArrayBounds.lower
DO
IF LSI > SearchedArrayD.ArrayBounds.upper THEN
lSIeRROR = -1
EXIT DO
END IF
IF SearchedArray(LSI) = SearchedArray(SearchedArrayD.index) THEN EXIT DO
LSI = LSI + 1
LOOP
IF lSIeRROR THEN
STOP
END IF
SearchedArrayD.index = SearchedArrayD.index + 1
LinearSearchfINISH! = TIMER(.001)
LOOP UNTIL (LinearSearchfINISH! - LinearSearchStart!) > BinarySearchFinish! - BinarySearchsTART! OR SearchedArrayD.index > SearchedArrayD.ArrayBounds.upper
PRINT "LINEAR SEARCH FOUND"; SearchedArrayD.index; "iTEMS IN THE TIME BINARY SEARCH DID."
PRINT "Binary search performed "; (SearchedArrayD.ArrayBounds.upper - SearchedArrayD.ArrayBounds.lower + 1) / SearchedArrayD.index; "times faster."
PRINT "yet Linear Search was only able to cover"; 100 * (SearchedArrayD.index / (SearchedArrayD.ArrayBounds.upper - SearchedArrayD.ArrayBounds.lower + 1)); "%."
'* simply fills a numeric array with numbers between SetArray_min and SetArray_max, inclusively
'* in a large enough array, SetArray_min and SetArray_max will appear at least once.
SUB SetArray (a() AS _INTEGER64, ArrayD AS ArrayDescript, SetArray_min AS _INTEGER64, SetArray_max AS _INTEGER64)
ArrayD.index = ArrayD.ArrayBounds.lower
DO
a(ArrayD.index) = SetArray_min + (SetArray_max - SetArray_min) * RND
ArrayD.index = ArrayD.index + 1
LOOP UNTIL ArrayD.index > ArrayD.ArrayBounds.upper
ArrayD.index = ArrayD.ArrayBounds.lower
END SUB
'********************
'* Binary search is roughly the way one seeks a particular name entry in a sorted
'* phone directory. It examines the middle element and disregards the half this
'* searched object cannot be in. For very long lists and arrays It is MUCH faster
'* than linear search which must look through all entries until a match is found or
'* the end of the list is reached without a match. This version of Binary Search
'' quits as soon as a match is found or the indexes BinarySearch_L and BinarySearch_H
'* cross, which indicates the item being searched simply is not contained in the
'* searched list. The average number of iterations for Binary Search is
'* 1 + Floor(Log(BinarySearch_Finish - BinarySearch_Start + 1) / Log(2))
'* Binary search cannot be used on unsorted arrays or lists. This version also avoids
'* overflow when calculating BinarySearch_M, a hidden mistake programmers can very
'* easily overlook. Every doubling of input size makes this search algorithm perform
'* only 1 more very fast iteration of the Binary Search code body, making this a
'* logarithmic class complexity. The official complexity classification is O(LogN).
'********************
SUB BinarySearch (CGSortLibArr() AS _INTEGER64, BinarySearch_Start AS _INTEGER64, BinarySearch_Finish AS _INTEGER64, BinarySearch_SearchTarget AS _INTEGER64, BinarySearch_where AS _INTEGER64, BinarySearch_errorflag AS INTEGER)
BinarySearch_errorflag = 0
'******************** These must be the same numerical type as the variable parameters they hold.
DIM BinarySearch_L AS _INTEGER64: BinarySearch_L = BinarySearch_Start
DIM BinarySearch_C AS _INTEGER64: BinarySearch_M = BinarySearch_Start
DIM BinarySearch_H AS _INTEGER64: BinarySearch_H = BinarySearch_Finish
'********************
DO
BinarySearch_C = BinarySearch_L + (BinarySearch_H - BinarySearch_L) \ 2
SELECT CASE CGSortLibArr(BinarySearch_C)
CASE IS < BinarySearch_SearchTarget
BinarySearch_L = BinarySearch_C + 1
CASE IS > BinarySearch_SearchTarget
BinarySearch_H = BinarySearch_C - 1
CASE ELSE
BinarySearch_where = BinarySearch_C
EXIT SUB
END SELECT
LOOP UNTIL BinarySearch_L > BinarySearch_H
BinarySearch_errorflag = -1
END SUB
SUB QuickSortIterative (CGSortLibArr() AS _INTEGER64, QSIStart AS _INTEGER64, QSIFinish AS _INTEGER64, order&)
DIM QSI_Local_Compare AS DOUBLE '* MUST be same type as element of CGSortLibArr()
'* These MUST be the appropriate type for the range being sorted
DIM QSI_Local_I AS _INTEGER64
DIM QSI_local_J AS _INTEGER64
DIM QSI_Local_Hi AS _INTEGER64
DIM QSI_Local_Low AS _INTEGER64
DIM QSI_Local_Mid AS _INTEGER64
'****************************************************************
'* Integer suffices for QSI_Local_MinStackPtr unless you're sorting more than 2^32767 elements.
DIM QSI_Local_MinStackPtr AS INTEGER: QSI_Local_MinStackPtr = 0
DIM QSI_Local_QSI_local_CurrentStackPtr AS INTEGER: QSI_Local_QSI_local_CurrentStackPtr = 0
DIM QSI_Local_FinishMinusStart AS _INTEGER64: QSI_Local_FinishMinusStart = QSIFinish - QSIStart
DIM QSI_local_Remainder AS INTEGER
'* yes, the equation log(QSIfinish-QSIstart)/log(2)+1 works too
DO
QSI_local_Remainder = QSI_Local_FinishMinusStart - (2 * INT(QSI_Local_FinishMinusStart / 2))
QSI_Local_FinishMinusStart = (QSI_Local_FinishMinusStart - QSI_local_Remainder) / 2
QSI_Local_MinStackPtr = QSI_Local_MinStackPtr + 1
LOOP UNTIL QSI_Local_FinishMinusStart < 1
'* MUST be appropriate type to handle the range (QSIfinish-QSIstart) being sorted
DIM QSI_LStack(0 TO QSI_Local_MinStackPtr, 0 TO 1) AS _INTEGER64
QSI_local_CurrentStackPtr = 0
QSI_LStack(QSI_local_CurrentStackPtr, 0) = QSIStart
QSI_LStack(QSI_local_CurrentStackPtr, 1) = QSIFinish
DO
QSI_Local_Low = QSI_LStack(QSI_local_CurrentStackPtr, 0)
QSI_Local_Hi = QSI_LStack(QSI_local_CurrentStackPtr, 1)
DO
QSI_Local_I = QSI_Local_Low
QSI_local_J = QSI_Local_Hi
QSI_Local_Mid = QSI_Local_Low + (QSI_Local_Hi - QSI_Local_Low) \ 2
QSI_Local_Compare = CGSortLibArr(QSI_Local_Mid)
SELECT CASE order&
CASE 1
DO
DO WHILE CGSortLibArr(QSI_Local_I) < QSI_Local_Compare
QSI_Local_I = QSI_Local_I + 1
LOOP
DO WHILE CGSortLibArr(QSI_local_J) > QSI_Local_Compare
QSI_local_J = QSI_local_J - 1
LOOP
IF QSI_Local_I <= QSI_local_J THEN
SWAP CGSortLibArr(QSI_Local_I), CGSortLibArr(QSI_local_J)
QSI_Local_I = QSI_Local_I + 1
QSI_local_J = QSI_local_J - 1
END IF
LOOP UNTIL QSI_Local_I > QSI_local_J
CASE ELSE
DO
DO WHILE CGSortLibArr(QSI_Local_I) > QSI_Local_Compare
QSI_Local_I = QSI_Local_I + 1
LOOP
DO WHILE CGSortLibArr(QSI_local_J) < QSI_Local_Compare
QSI_local_J = QSI_local_J - 1
LOOP
IF QSI_Local_I <= QSI_local_J THEN
SWAP CGSortLibArr(QSI_Local_I), CGSortLibArr(QSI_local_J)
QSI_Local_I = QSI_Local_I + 1
QSI_local_J = QSI_local_J - 1
END IF
LOOP UNTIL QSI_Local_I > QSI_local_J
END SELECT
IF QSI_local_J - QSI_Local_Low < QSI_Local_Hi - QSI_Local_I THEN
IF QSI_Local_I < QSI_Local_Hi THEN
QSI_LStack(QSI_local_CurrentStackPtr, 0) = QSI_Local_I
QSI_LStack(QSI_local_CurrentStackPtr, 1) = QSI_Local_Hi
QSI_local_CurrentStackPtr = QSI_local_CurrentStackPtr + 1
END IF
QSI_Local_Hi = QSI_local_J
ELSE
IF QSI_Local_Low < QSI_local_J THEN
QSI_LStack(QSI_local_CurrentStackPtr, 0) = QSI_Local_Low
QSI_LStack(QSI_local_CurrentStackPtr, 1) = QSI_local_J
QSI_local_CurrentStackPtr = QSI_local_CurrentStackPtr + 1
END IF
QSI_Local_Low = QSI_Local_I
END IF
LOOP WHILE QSI_Local_Low < QSI_Local_Hi
QSI_local_CurrentStackPtr = QSI_local_CurrentStackPtr - 1
LOOP UNTIL QSI_local_CurrentStackPtr < 0
END SUB
[T/code]
