-- heap_sort_2.adb

procedure HEAP_SORT_2 ( ARRAY_VAL : in out ARRAY_TYPE ;
                        WC , WE : in out INTEGER ) is
    subtype POS_RANGE is INTEGER range
                         INDEX_TYPE'Pos( Array_Val'First ) ..
                         INDEX_TYPE'Pos( Array_Val'Last );

    Last_Parent_Pos   : constant POS_RANGE := POS_RANGE'First +
                        ((( POS_RANGE'Last - POS_RANGE'First )
                            - 1 ) / 2 );

    Last_Parent_Index : constant INDEX_TYPE := INDEX_TYPE'Val(
                        Last_Parent_Pos );

    Item_Temp : ELEMENT_TYPE ; -- Exchanges the value of two elements

    procedure REMAKE_HEAP ( Parent_Index : in     INDEX_TYPE;
                            Last_Index   : in     INDEX_TYPE ) is
      Last_Parent_Pos   : constant POS_RANGE := POS_RANGE'First +
                          ((( INDEX_TYPE'Pos( Last_Index ) -
                          POS_RANGE'First ) - 1 ) / 2 );
      Last_Parent_Index : constant INDEX_TYPE := INDEX_TYPE'Val(
                          Last_Parent_Pos );
      L_Child           : INDEX_TYPE;
      R_Child           : INDEX_TYPE;
      Max_Child_Index   : INDEX_TYPE;
      Parent_Temp       : INDEX_TYPE := Parent_Index;
    begin
      loop
        if Parent_Temp > Last_Parent_Index then
          exit;
        end if;
        L_Child := INDEX_TYPE'Val(((INDEX_TYPE'Pos(Parent_Temp)*2)-
                                  POS_RANGE'First)+1);
        if L_Child = Last_Index then
          Max_Child_Index := L_Child;
        else
          R_Child := INDEX_TYPE'Succ( L_Child );
          WC := WC + 1 ;
          if Array_Val( L_Child ) > Array_Val( R_Child ) then
            Max_Child_Index := L_Child;
          else
            Max_Child_Index := R_Child;
          end if;
        end if;
        WC := WC + 1 ;
        if Array_Val( Max_Child_Index ) > Array_Val( Parent_Temp ) then
          WE := WE + 1 ;
          Item_Temp := Array_Val( Max_Child_Index );
          Array_Val( Max_Child_Index ) := Array_Val( Parent_Temp );
          Array_Val( Parent_Temp ) := Item_Temp;
          Parent_Temp := Max_Child_Index;
        else
          exit;
        end if;
      end loop;
    end REMAKE_HEAP;

  begin
    if Array_Val'Length <= 1 then
      return;
    end if;
    for Index_Val in reverse Array_Val'First .. Last_Parent_Index loop
      REMAKE_HEAP( Index_Val, Array_Val'Last );
    end loop;
    WE := WE + 1 ;
    Item_Temp := Array_Val( Array_Val'First );
    Array_Val( Array_Val'First ) := Array_Val( Array_Val'Last );
    Array_Val( Array_Val'Last ) := Item_temp;
    for Index_Val in reverse INDEX_TYPE'Succ( Array_Val'First ) ..
        INDEX_TYPE'Pred( Array_Val'Last ) loop
      REMAKE_HEAP( Array_Val'First, Index_Val );
      WE := WE + 1 ;
      Item_Temp := Array_Val( Array_Val'First );
      Array_Val( Array_Val'First ) := Array_Val( Index_Val );
      Array_Val( Index_Val ) := Item_Temp;
    end loop;
end HEAP_SORT_2;