tdfPCY - Online Ada Compiler & Debugging Tool

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Test_Sort is

   type array_type is array (Integer range <>) of Integer;

   -- constants for choosing sort
   small  : constant Integer := 5;
   medium : constant Integer := 10;

   -- Insertion Sort
   procedure sort_1(A : in out array_type) is
      Temp : Integer;
      J    : Integer;
   begin
      for I in A'First + 1 .. A'Last loop
         Temp := A(I);
         J := I - 1;
         while J >= A'First and then A(J) > Temp loop
            A(J + 1) := A(J);
            exit when J = A'First;
            J := J - 1;
         end loop;
         if A(J) > Temp then
            A(J + 1) := A(J);
            A(J) := Temp;
         else
            A(J + 1) := Temp;
         end if;
      end loop;
   end sort_1;

   -- Bubble Sort
   procedure sort_2(A : in out array_type) is
      Temp    : Integer;
      Swapped : Boolean := True;
   begin
      while Swapped loop
         Swapped := False;
         for I in A'First .. A'Last - 1 loop
            if A(I) > A(I + 1) then
               Temp := A(I);
               A(I) := A(I + 1);
               A(I + 1) := Temp;
               Swapped := True;
            end if;
         end loop;
      end loop;
   end sort_2;

   -- Heap Sort
   procedure sort_3(A : in out array_type) is

      procedure Heapify(N, I : Integer) is
         Largest : Integer := I;
         L : Integer := 2 * I + 1;
         R : Integer := 2 * I + 2;
         Temp : Integer;

         function To_Index(X : Integer) return Integer is
         begin
            return A'First + X;
         end To_Index;
      begin
         if L < N and then A(To_Index(L)) > A(To_Index(Largest)) then
            Largest := L;
         end if;
         if R < N and then A(To_Index(R)) > A(To_Index(Largest)) then
            Largest := R;
         end if;
         if Largest /= I then
            Temp := A(To_Index(I));
            A(To_Index(I)) := A(To_Index(Largest));
            A(To_Index(Largest)) := Temp;
            Heapify(N, Largest);
         end if;
      end Heapify;

      N : constant Integer := A'Length;
      Temp : Integer;

      function To_Index(X : Integer) return Integer is
      begin
         return A'First + X;
      end To_Index;

   begin
      for I in reverse 0 .. (N / 2 - 1) loop
         Heapify(N, I);
      end loop;

      for I in reverse 1 .. N - 1 loop
         Temp := A(A'First);
         A(A'First) := A(To_Index(I));
         A(To_Index(I)) := Temp;
         Heapify(I, 0);
      end loop;
   end sort_3;

   -- General sort procedure
   procedure sort(A : in out array_type) is
   begin
      if A'Length <= small then
         sort_1(A);
      elsif A'Length <= medium then
         sort_2(A);
      else
         sort_3(A);
      end if;
   end sort;

   -- Test arrays
   A : array_type(1 .. 10) := (10, -5, 3, 0, 8, -2, 7, 4, 1, 6);
   B : array_type(1 .. 5) := (3, 1, 4, 5, 2);

begin
   Put_Line("Before sorting A:");
   for I in A'Range loop Put(A(I)'Img & " "); end loop;
   New_Line;

   Put_Line("Before sorting B:");
   for I in B'Range loop Put(B(I)'Img & " "); end loop;
   New_Line;

   sort(A);
   sort(B);

   Put_Line("After sorting A:");
   for I in A'Range loop Put(A(I)'Img & " "); end loop;
   New_Line;

   Put_Line("After sorting B:");
   for I in B'Range loop Put(B(I)'Img & " "); end loop;
   New_Line;

end Test_Sort;