'****************************************
'* The IntroSort() algorithm extended to QBxx because there is no qbxx-compatible code
'* The IntroSort algorithm extended to qb64 because i could find no pure qbxx code
'* 03Jun2017, by CodeGuy -- further mods for use in sorting library 03 Aug 2017
'* Introspective Sort (IntroSort) falls back to MergeSort after so many levels of
'* recursion and is good for highly redundant data (aka few unique)
'* for very short runs, it falls back to InsertionSort.
IntroSort_MaxRecurseLevel = 15
IF IntroSort_start
< IntroSort_finish
THEN IF IntroSort_finish
- IntroSort_start
> 31 THEN IF IntroSort_level
> IntroSort_MaxRecurseLevel
THEN HeapSort CGSortLibArr(), IntroSort_start, IntroSort_finish, order
IntroSort_level = IntroSort_level + 1
QuickSortIJ CGSortLibArr(), IntroSort_start, IntroSort_finish, IntroSort_i, IntroSort_J, order
QuickSortIntrospective CGSortLibArr(), IntroSort_start, IntroSort_J, order
QuickSortIntrospective CGSortLibArr(), IntroSort_i, IntroSort_finish, order
IntroSort_level = IntroSort_level - 1
InsertionSort CGSortLibArr(), IntroSort_start, IntroSort_finish, order
DIM Compare
AS DOUBLE '* MUST be the same type as CGSortLibArr() i = start
j = finish
Compare = CGSortLibArr(i + (j - i) \ 2)
i = i + 1
j = j - 1
SWAP CGSortLibArr
(i
), CGSortLibArr
(j
) i = i + 1
j = j - 1
i = i + 1
j = j - 1
SWAP CGSortLibArr
(i
), CGSortLibArr
(j
) i = i + 1
j = j - 1
FOR InSort_Local_i
= start
+ 1 TO finish
InSort_Local_j = InSort_Local_i - 1
IF CGSortLibArr
(InSort_Local_i
) < CGSortLibArr
(InSort_Local_j
) THEN InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
IF (InSort_Local_ArrayTemp
< CGSortLibArr
(InSort_Local_j
)) THEN CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
InSort_Local_j = InSort_Local_j - 1
CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
FOR InSort_Local_i
= start
+ 1 TO finish
InSort_Local_j = InSort_Local_i - 1
IF CGSortLibArr
(InSort_Local_i
) > CGSortLibArr
(InSort_Local_j
) THEN InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
IF (InSort_Local_ArrayTemp
> CGSortLibArr
(InSort_Local_j
)) THEN CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
InSort_Local_j = InSort_Local_j - 1
CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
FOR i
= start
+ 1 TO finish
PercolateUp CGSortLibArr(), start, i, order
SWAP CGSortLibArr
(start
), CGSortLibArr
(i
) PercolateDown CGSortLibArr(), start, i - 1, order
i = start
'* Move the value in GetPixel!!!(start) down the heap until it has
'* reached its proper node (that is, until it is less than its parent
'* node or until it has reached MaxLevel!!!, the bottom of the current heap):
child = 2 * (i - start) + start ' Get the subscript for the Child node.
'* Reached the bottom of the heap, so exit this procedure:
'* If there are two Child nodes, find out which one is bigger:
ax = child + 1
IF CGSortLibArr
(ax
) > CGSortLibArr
(child
) THEN child = ax
'* Move the value down if it is still not bigger than either one of
'* its Child!!!ren:
IF CGSortLibArr
(i
) < CGSortLibArr
(child
) THEN SWAP CGSortLibArr
(i
), CGSortLibArr
(child
) i = child
'* Otherwise, CGSortLibArr() has been restored to a heap from start to MaxLevel!!!,
'* so exit:
'* If there are two Child nodes, find out which one is smaller:
ax = child + 1
IF CGSortLibArr
(ax
) < CGSortLibArr
(child
) THEN child = ax
'* Move the value down if it is still not smaller than either one of
'* its Child!!!ren:
IF CGSortLibArr
(i
) > CGSortLibArr
(child
) THEN SWAP CGSortLibArr
(i
), CGSortLibArr
(child
) i = child
'* Otherwise, CGSortLibArr() has been restored to a heap from start to MaxLevel!!!,
'* so exit:
i = MaxLevel
'* Move the value in CGSortLibArr(MaxLevel!!!) up the heap until it has
'* reached its proper node (that is, until it is greater than either
'* of its Child!!! nodes, or until it has reached 1, the top of the heap):
'* Get the subscript for the parent node.
parent = start + (i - start) \ 2
'* The value at the current node is still bigger than the value at
'* its parent node, so swap these two array elements:
IF CGSortLibArr
(i
) > CGSortLibArr
(parent
) THEN SWAP CGSortLibArr
(parent
), CGSortLibArr
(i
) i = parent
'* Otherwise, the element has reached its proper place in the heap,
'* so exit this procedure:
i = MaxLevel
'* Move the value in CGSortLibArr(MaxLevel!!!) up the heap until it has
'* reached its proper node (that is, until it is greater than either
'* of its Child!!! nodes, or until it has reached 1, the top of the heap):
'* Get the subscript for the parent node.
parent = start + (i - start) \ 2
'* The value at the current node is still smaller than the value at
'* its parent node, so swap these two array elements:
IF CGSortLibArr
(i
) < CGSortLibArr
(parent
) THEN SWAP CGSortLibArr
(parent
), CGSortLibArr
(i
) i = parent
'* Otherwise, the element has reached its proper place in the heap,
'* so exit this procedure: