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

-- -------------------------------------------------------------------
-- Introsort
-- Purpose:
--   Run the program: read the input, sort the populated values, and write the result.
-- Parameters:
--   None; file paths and array state are supplied by this outer procedure.
-- Returns:
--   No value; reports elapsed time and algorithm call counts.
-- Side effects:
--   Performs file I/O, updates Values and Count, and invokes the sorting helpers.
-- -------------------------------------------------------------------
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;

   -- -------------------------------------------------------------------
   -- Read_File
   -- Purpose:
   --   Read non-blank integer records from the named input file into the program's collection or shared array.
   -- Parameters:
   --   fileSpec - input or output file path.
   -- Returns:
   --   No value; fills Values and updates Count.
   -- Side effects:
   --   Opens and closes the input file; populates the collection or shared array and may update its element count.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Save_File
   -- Purpose:
   --   Write the sorted integer collection or shared array to the named output file, one value per line.
   -- Parameters:
   --   fileSpec - input or output file path.
   -- Returns:
   --   No value; writes the output file.
   -- Side effects:
   --   Creates or replaces the output file and reports file progress.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Sift_Down
   -- Purpose:
   --   Restore max-heap order below the specified root within the active heap range.
   -- Parameters:
   --   root - current root index in the heap portion.
   --   start - inclusive first index of the heap range.
   --   finish - exclusive end index of the heap range.
   -- Returns:
   --   No value; rearranges the range in place.
   -- Side effects:
   --   Mutates the sequence and may stop early once the heap property is restored.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Heap_Sort
   -- Purpose:
   --   Sort the selected range in place with heapsort; introsort uses this as its worst-case fallback.
   -- Parameters:
   --   start - inclusive first index of the range being processed.
   --   finish - exclusive end index of the range being processed.
   -- Returns:
   --   No value; sorts the range in place.
   -- Side effects:
   --   Mutates the selected range and increments the heapsort counter where present.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Insert_Sort
   -- Purpose:
   --   Sort the selected range in place with insertion sort, the low-overhead path for short ranges.
   -- Parameters:
   --   start - inclusive first index of the range being processed.
   --   finish - exclusive end index of the range being processed.
   -- Returns:
   --   No value; sorts the range in place.
   -- Side effects:
   --   Mutates the selected range and increments the insertion-sort counter where present.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Partition
   -- Purpose:
   --   Partition the selected range around its middle-element pivot, then return the first index of the right-hand range.
   -- Parameters:
   --   start - inclusive first index of the range being processed.
   --   finish - exclusive end index of the range being processed.
   -- Returns:
   --   The first index of the right partition; both resulting ranges remain within the original bounds.
   -- Side effects:
   --   Mutates the selected range in place; uses a middle element as pivot and advances inward scanning indices.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Intro_Sort
   -- Purpose:
   --   Sort the selected range in place: use insertion sort for short ranges, heapsort when the depth budget is exhausted, otherwise partition and recurse.
   -- Parameters:
   --   start - inclusive first index of the range being processed.
   --   finish - exclusive end index of the range being processed.
   --   maxdepth - remaining partition budget before the heapsort fallback.
   -- Returns:
   --   No value; sorts the selected range in place.
   -- Side effects:
   --   Mutates the selected range and updates the introsort counter; recursive calls reduce the depth budget.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Log2
   -- Purpose:
   --   Compute the integer base-2 size estimate used to initialize introsort's partition-depth budget.
   -- Parameters:
   --   value - positive integer whose base-2 size estimate is computed.
   -- Returns:
   --   An integer base-2 size estimate.
   -- Side effects:
   --   Does not modify the input sequence.
   -- -------------------------------------------------------------------
   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;

   -- -------------------------------------------------------------------
   -- Perform_Sort
   -- Purpose:
   --   Choose an initial depth budget, run the top-level introsort, and measure its elapsed time.
   -- Parameters:
   --   None; this routine reads arguments from its enclosing context or shared state.
   -- Returns:
   --   Elapsed time measured by this implementation.
   -- Side effects:
   --   Starts/stops a timer, prints progress, and invokes introsort on the full sequence.
   -- -------------------------------------------------------------------
   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;