' Ascending integer (Int32) heap sort. ' ' For i = 1, 2, ..., n, sort components of key_array(i) ' into ascending order using heap sort.

' Ascending integer (Int32) heap sort. ' ' For i = 1, 2, ..., n, sort components of key_array(i) ' into ascending order using heap sort. ' ' We check parameters for reasonable values and, in case of ' a error, raise the error condition. ' ' Upon return, for i = 1, 2, ..., n - 1, ' ' key_array( i ) <= key_array( i + 1 ) ' ' The code here is 'structured' in the sense of E. Dijkstra ' and, thus, is without the GOTO statements of own Watson ' PL/I heap sort code. ' ' The array subscript logic here is done carefully enough ' that it should never overflow even for the largest ' possible value of n. ' ' For some constant k (depending on the computer, compiler, ' etc. but not depending on the parameters) the execution ' time is guaranteed to be closely just ' ' k*n*log(n) ' ' in the worst case. ' ' The code here needs a 'sift' loop in two places; the code ' is the same in both places. ' ' The work here is 'in place', that is, uses no storage ' whose size depends on the passed parameters. ' Sub ai_heap_sort02( _ ByRef key_array() As Int32, _ ByVal n As Int32 ) Dim routine_name As String = "ai_heap_sort02" Dim error_code As Int32 = 0 Dim i_2 As Int32 = 2 Dim i_first, i_middle, i_last As Int32 Dim i_father0 As Int32 Dim i_father, i_child1, i_child2, i_max_child As Int32 ' We need one working location of data type the same as the ' components of parameter key_array(): Dim key_father As Int32 Try ' Get started: error_code = 1001 If n <= 0 Then err.raise(error_code, routine_name) error_code = 1002 If key_array.GetUpperBound(0) < n Then err.raise(error_code, routine_name) End If error_code = 1003 i_first = 1 i_last = n i_middle = i_last \ i_2 i_father0 = i_middle + 1 ' Build heap Do i_father0 = i_father0 - 1 If i_father0 < i_first Then Exit Do key_father = key_array( i_father0 ) i_father = i_father0 ' Sift Do If i_father < i_middle Then i_child1 = i_father + i_father i_child2 = i_child1 + 1 If key_array( i_child1 ) > key_array( i_child2 ) Then i_max_child = i_child1 Else i_max_child = i_child2 End If If key_array( i_max_child ) > key_father Then key_array( i_father ) = key_array( i_max_child ) i_father = i_max_child Continue Do Else key_array( i_father ) = key_father Exit Do End If Else ' i_father >= i_middle If i_father > i_middle Then key_array( i_father ) = key_father Exit Do End If i_child1 = i_father + i_father ' i_father = i_middle If i_child1 < i_last Then i_child2 = i_child1 + 1 If key_array( i_child1 ) > key_array( i_child2 ) Then i_max_child = i_child1 Else i_max_child = i_child2 End If Else ' i_child1 = i_last i_max_child = i_child1 End If If key_array( i_max_child ) > key_father Then key_array( i_father ) = key_array( i_max_child ) key_array ( i_max_child ) = key_father Else key_array ( i_father ) = key_father End If Exit Do End If Loop ' End of sift loop Loop ' End of build heap loop ' Sort heap i_first = 1 i_last = n Do key_father = key_array( i_last ) key_array( i_last ) = key_array( i_first ) key_array( i_first ) = key_father i_father = i_first i_last = i_last - 1 If i_last <= i_first Then Exit Do i_middle = i_last \ 2 ' Sift Do If i_father < i_middle Then i_child1 = i_father + i_father i_child2 = i_child1 + 1 If key_array( i_child1 ) > key_array( i_child2 ) Then i_max_child = i_child1 Else i_max_child = i_child2 End If If key_array( i_max_child ) > key_father Then key_array( i_father ) = key_array( i_max_child ) i_father = i_max_child Continue Do Else key_array( i_father ) = key_father Exit Do End If Else ' i_father >= i_middle If i_father > i_middle Then key_array( i_father ) = key_father Exit Do End If i_child1 = i_father + i_father ' i_father = i_middle If i_child1 < i_last Then i_child2 = i_child1 + 1 If key_array( i_child1 ) > key_array( i_child2 ) Then i_max_child = i_child1 Else i_max_child = i_child2 End If Else ' i_child1 = i_last i_max_child = i_child1 End If If key_array( i_max_child ) > key_father Then key_array( i_father ) = key_array( i_max_child ) key_array ( i_max_child ) = key_father Else key_array ( i_father ) = key_father End If Exit Do End If Loop ' End of sift loop Loop ' End of sort heap loop Catch err.raise(error_code, routine_name) End Try out: Return End Sub