' 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