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

procedure Introsort is

   Max_Vals: constant Natural := 1000;
   type Integer_Array is array (Natural range 0..Max_Vals) of Integer;
   Values: Integer_Array;
   Count: Natural;
   Intros, Inserts, Heaps: Natural := 0;
   Elapsed: Duration;

   procedure Read_File(fileSpec: String) is
      Input_File: File_Type;
   begin
      Count := 0;
      put("READING INPUT FILE...");
      Open(Input_File, In_File, fileSpec);
      While not End_Of_File(Input_File) loop
         Get(Input_File, Values(Count));
         Count := Count + 1;
         exit when Count > Max_Vals;
      end loop;
      Close(Input_File);
      Put_Line("DONE.");
   end Read_File;

   procedure Save_File(fileSpec: String) is
      Output_File: File_Type;
   begin
      put("SAVING OUTPUT FILE...");
      Create(Output_File, Out_File, fileSpec);
      for Index in 0..Count-1 loop
         put(Output_File, Values(Index));
         New_Line(Output_File);
      end loop;
      Close(Output_File);
      Put_Line("DONE.");
   end Save_File;

   procedure Sift_Down(root: Natural; start: Natural; finish: Natural) is
      Child: Natural;
      Temp: Integer;
   begin
      while start + 2 * (root - start) + 1 < finish loop
         Child := start + 2 * (root - start) + 1;
         if Child + 1 < Finish and then values(Child) < values(Child + 1) then
            Child := Child + 1;
         end if;
         exit when values(root) >= values(Child);
         Temp := values(root);
         values(root) := values(Child);
         values(Child) := Temp;
         root := child;
      end loop;
   end Sift_Down;

   procedure Heap_Sort(start: Natural; finish: Natural) is
      Seed: Natural;
      Temp: Integer;
   begin
      Heaps := Heaps + 1;
      Seed := start + (finish - start) / 2 - 1;
      for Root in reverse Seed..Start loop
         Sift_Down(Root, start, finish);
      end loop;
      for Last in reverse (Finish-1)..(Start+1) loop
         Temp := Values(start);
         Values(start) := Values(Last);
         Values(Last) := Temp;
         Sift_Down(start, start, Last);
      end loop;
   end Heap_Sort;

   procedure Insert_Sort(start: Natural; finish: Natural) is
      Value, Pos: Integer;
   begin
      Inserts := Inserts + 1;
      for Index in start..(finish - 1) loop
         Value := Values(Index);
         Pos := Index - 1;
         while Pos >= start and then Values(Pos) > Value loop
           Values(Pos + 1) := Values(Pos);
            Pos := Pos - 1;
         end loop;
         Values(Pos + 1) := Value;
      end loop;
   end Insert_Sort;

   function Partition(start: Natural; finish: Natural) return Natural is
      Temp, Pivot: Integer;
      Left, Right: Natural;
   begin
      Left := start;
      Right := finish - 1;
      Pivot := Values(start + (finish - start) / 2);
      while Left <= Right loop
         while Left <= Right and then Values(Left) < Pivot loop
            Left := Left + 1;
         end loop;
         while Left <= Right and then Values(Right) > Pivot loop
            Right := Right - 1;
         end loop;
      if Left <= Right then
         Temp := Values(Left);
         Values(Left) := Values(Right);
         Values(Right) := Temp;
         Left := Left + 1;
         Right := Right - 1;
         end if;
      end loop;
      return Left;
   end Partition;

   procedure Intro_Sort(start: Natural; finish: Natural; maxdepth: Natural) is
      Length, Part: Natural;
   begin
      Intros := Intros + 1;
      Length := finish - start;
      if Length <= 1 then
         return;
      end if;
      if Length < 16 then
         Insert_Sort(start, finish);
      else
         begin
            if maxdepth <= 1 then
               Heap_Sort(start, finish);
            else
               begin
                  Part := Partition(start, finish);
                  Intro_Sort(start, part, maxdepth - 1);
                  Intro_Sort(part, finish, maxdepth - 1);
               end;
            end if;
         end;
      end if;
   end Intro_Sort;

   function Log2(value: Natural) return Natural is
      Num: Natural;
      v: Natural := value;
   begin
      Num := 0;
      while v > 1 loop
         v := v / 2;
         Num := Num + 1;
      end loop;
      return Num;
   end Log2;

   function Perform_Sort return Duration is
     Start_Time, End_Time: Time;
      Max_Depth: Natural;
   begin
      put("SORTING ELEMENTS...");
      Start_Time := Clock;
      if Count > 1 then
         Max_Depth := Log2(Count) * 2;
      else
         Max_Depth := 0;
      end if;
      Intro_Sort(0, Count, Max_Depth);
      End_Time := Clock;
      Put_Line("DONE.");
      return End_Time - Start_Time;
   end Perform_Sort;

begin
   Put_Line("=========INTROSORT ADA==========");
   Read_File("D:\Sorting\Sorting_Input.txt");
   Elapsed := Perform_Sort;
   Save_File("D:\Sorting\Output_Ada.txt");
   Put_Line("==========RUN COMPLETE==========");
   Put_Line("INTROSORT TOOK " & Duration'Image(Elapsed) & " SECONDS.");
   Put_Line("================================");
   Put_Line("SORT CALLED | TIMES");
   Put_Line("------------+-------------------");
   Put_Line("Intro       | " & Natural'Image(Intros));
   Put_Line("Insertion   | " & Natural'Image(Inserts));
   Put_Line("Heap        | " & Natural'Image(Heaps));
   Put_Line("--------------------------------");
end Instrosort;