PROGRAM INTROSORT;

CONST
  MAXVALS = 1000;

TYPE
  TINTARRAY = ARRAY[1..MAXVALS] OF LONGINT;

VAR
  VALUES: TINTARRAY;
  COUNT: LONGINT;
  CODE: INTEGER;
  ELAPSED: REAL;
  INTROS: INTEGER;
  INSERTS: INTEGER;
  HEAPS: INTEGER;

{
  -------------------------------------------------------------------
  READFILE
  Purpose:
    Read integer lines from the named input file into the shared array.
  Parameters:
    FILESPEC - input file path to read.
  Returns:
    No value; populates VALUES and COUNT.
  Side effects:
    Opens and closes the input file and prints read progress.
  -------------------------------------------------------------------
}
PROCEDURE READFILE(CONST FILESPEC: STRING);
VAR
  INPUTFILE: TEXT;
  LINE: STRING;
BEGIN
  WRITE('READING INPUT FILE...');
  ASSIGN(INPUTFILE,FILESPEC);
  RESET(INPUTFILE);
  COUNT := 0;
  WHILE NOT EOF(INPUTFILE) DO
  BEGIN
    READLN(INPUTFILE,LINE);
    IF LINE <> '' THEN
    BEGIN
      INC(COUNT);
      VAL(LINE,VALUES[COUNT], CODE);
    END;
  END;
  CLOSE(INPUTFILE);
  WRITELN('DONE.');
END;

{
  -------------------------------------------------------------------
  SAVEFILE
  Purpose:
    Write the sorted integer collection or shared array to the named output file, one value per line.
  Parameters:
    FILESPEC - output file path to create or replace.
  Returns:
    No value; writes the output file.
  Side effects:
    Creates or replaces the output file and reports file progress.
  -------------------------------------------------------------------
}
PROCEDURE SAVEFILE(CONST FILESPEC: STRING);
VAR
  OUTPUTFILE: TEXT;
  INDEX: LONGINT;
BEGIN
  WRITE('SAVING OUTPUT FILE...');
  ASSIGN(OUTPUTFILE, FILESPEC);
  REWRITE(OUTPUTFILE);
  FOR INDEX := 1 TO COUNT DO
    WRITELN(OUTPUTFILE, VALUES[INDEX]);
  CLOSE(OUTPUTFILE);
  WRITELN('DONE.');
END;

{
  -------------------------------------------------------------------
  SIFTDOWN
  Purpose:
    Restore max-heap order below the specified root within the active heap range.
  Parameters:
  ROOT - current heap root index.
  START - inclusive first index of the active range.
  FINISH - exclusive end index of the active range.
  Returns:
    No value; rearranges the range in place.
  Side effects:
    Mutates the sequence and may stop once the heap property is restored.
  -------------------------------------------------------------------
}
PROCEDURE SIFTDOWN(ROOT, START, FINISH: LONGINT);
VAR
  CHILD, TEMP: LONGINT;
BEGIN
  WHILE(START + 2 * (ROOT - START) + 1 < FINISH) DO
  BEGIN
    CHILD := START + 2 * (ROOT - START) + 1;
    IF (CHILD + 1 < FINISH) AND (VALUES[CHILD] < VALUES[CHILD + 1]) THEN
      INC(CHILD);
    IF(VALUES[ROOT] >= VALUES[CHILD]) THEN EXIT;
    TEMP := VALUES[ROOT];
    VALUES[ROOT] := VALUES[CHILD];
    VALUES[CHILD] := TEMP;
    ROOT := CHILD;
  END;
END;

{
  -------------------------------------------------------------------
  HEAPSORT
  Purpose:
    Sort the selected range in place with heapsort, the worst-case introsort fallback.
  Parameters:
  START - inclusive first index of the active range.
  FINISH - exclusive end index of the active range.
  Returns:
    No value; sorts the selected range in place.
  Side effects:
    Mutates the range and increments the heapsort counter where present.
  -------------------------------------------------------------------
}
PROCEDURE HEAPSORT(START, FINISH: LONGINT);
VAR
  ROOT, LAST: LONGINT;
  SEED, TEMP: LONGINT;
BEGIN
  INC(HEAPS);
  SEED := (START + (FINISH - START) DIV 2 - 1);
  FOR ROOT := SEED DOWNTO START DO
    SIFTDOWN(ROOT, START, FINISH);
  FOR LAST := FINISH - 1 DOWNTO START + 1 DO
  BEGIN
    TEMP := VALUES[START];
    VALUES[START] := VALUES[LAST];
    VALUES[LAST] := TEMP;
    SIFTDOWN(START, START, LAST);
  END;
END;

{
  -------------------------------------------------------------------
  INSERTSORT
  Purpose:
    Sort the selected range in place with insertion sort, which is efficient for short ranges.
  Parameters:
  START - inclusive first index of the active range.
  FINISH - exclusive end index of the active range.
  Returns:
    No value; sorts the selected range in place.
  Side effects:
    Mutates the range and increments the insertion-sort counter where present.
  -------------------------------------------------------------------
}
PROCEDURE INSERTSORT(START, FINISH: LONGINT);
VAR
  INDEX, VALUE, POS: LONGINT;
BEGIN
  INC(INSERTS);
  FOR INDEX := START TO FINISH - 1 DO
  BEGIN
    VALUE := VALUES[INDEX];
    POS := INDEX - 1;
    WHILE (POS >= START) AND (VALUES[POS] > VALUE) DO
    BEGIN
      VALUES[POS + 1] := VALUES[POS];
      DEC(POS);
    END;
    VALUES[POS + 1] := VALUE;
  END;
END;

{
  -------------------------------------------------------------------
  PARTITION
  Purpose:
    Partition the selected range around its middle-element pivot and return the first index of the right-hand range.
  Parameters:
  START - inclusive first index of the active range.
  FINISH - exclusive end index of the active range.
  Returns:
    The first index of the right partition, which is also the left boundary of the recursive ranges.
  Side effects:
    Reorders the range in place while inward scans keep each access inside the active bounds.
  -------------------------------------------------------------------
}
FUNCTION PARTITION(START, FINISH: LONGINT): LONGINT;
VAR
  TEMP, LEFT, RIGHT, PIVOT: LONGINT;
BEGIN
  LEFT := START;
  RIGHT := FINISH - 1;
  PIVOT := VALUES[START + (FINISH - START) DIV 2];
  WHILE LEFT <= RIGHT DO
  BEGIN
    WHILE VALUES[LEFT] < PIVOT DO
      INC(LEFT);
    WHILE VALUES[RIGHT] > PIVOT DO
      DEC(RIGHT);
    IF LEFT <= RIGHT THEN
    BEGIN
        TEMP := VALUES[LEFT];
        VALUES[LEFT] := VALUES[RIGHT];
        VALUES[RIGHT] := TEMP;
        INC(LEFT);
        DEC(RIGHT);
    END;
  END;
  PARTITION := LEFT;
END;

{
  -------------------------------------------------------------------
  INTROSRT
  Purpose:
    Sort the selected range in place: insertion sort for short ranges, heapsort when the depth budget expires, otherwise partition and recurse.
  Parameters:
  START - inclusive first index of the active range.
  FINISH - exclusive end index of the active range.
  MAXDEPTH - remaining partition-depth budget before heapsort fallback.
  Returns:
    No value; sorts the selected range in place.
  Side effects:
    Mutates the range and updates the introsort counter; recursive calls reduce the depth budget.
  -------------------------------------------------------------------
}
PROCEDURE INTROSRT(START, FINISH, MAXDEPTH: LONGINT);
VAR
  LENGTH, PART: LONGINT;
BEGIN
  INC(INTROS);
  LENGTH := FINISH - START;
  IF LENGTH <= 1 THEN
    EXIT;
  IF LENGTH < 16 THEN
    INSERTSORT(START, FINISH)
  ELSE
  BEGIN
    IF MAXDEPTH <= 1 THEN
      HEAPSORT(START, FINISH)
    ELSE
      BEGIN
        PART := PARTITION(START,FINISH);
        INTROSRT(START,PART,MAXDEPTH - 1);
        INTROSRT(PART,FINISH,MAXDEPTH - 1);
      END;
  END;
END;

{
  -------------------------------------------------------------------
  LOG2
  Purpose:
    Compute the integer base-2 size estimate used to initialize introsort depth.
  Parameters:
  VAL - positive integer used to compute the base-2 size estimate.
  Returns:
    An integer base-2 size estimate.
  Side effects:
    Does not modify the input.
  -------------------------------------------------------------------
}
FUNCTION LOG2(VAL: LONGINT): LONGINT;
VAR
  NUM: INTEGER;
BEGIN
  NUM := 0;
  WHILE VAL > 1 DO
  BEGIN
    VAL := VAL DIV 2;
    NUM := NUM + 1;
  END;
  LOG2 := NUM
END;

{
  -------------------------------------------------------------------
  PERFORMSORT
  Purpose:
    Choose the initial depth budget, time the top-level introsort, and report completion.
  Parameters:
  None; this routine uses shared state or its enclosing context.
  Returns:
    Elapsed time measured by this implementation.
  Side effects:
    Starts and stops a timer, prints progress, and invokes introsort on the full sequence.
  -------------------------------------------------------------------
}
FUNCTION PERFORMSORT: REAL;
VAR
  STARTTIME, ENDTIME, MAXDEPTH: LONGINT;
BEGIN
  WRITE('SORTING ELEMENTS...');
  STARTTIME := MEM[$40:$6C];
  IF COUNT > 1 THEN
    MAXDEPTH := LOG2(COUNT) * 2
  ELSE
    MAXDEPTH := 0;
  INTROSRT(1, COUNT + 1, MAXDEPTH);
  ENDTIME := MEM[$40:$6C];
  WRITELN('DONE.');
  PERFORMSORT := (ENDTIME - STARTTIME) / 10.2;
END;

BEGIN
  WRITELN('========INTROSORT PASCAL========');
  READFILE('C:/INPUT.TXT');
  ELAPSED := PERFORMSORT;
  SAVEFILE('C:/OUTPUT.TXT');
  WRITELN('==========RUN COMPLETE==========');
  WRITELN('INTROSORT TOOK ', ELAPSED:0:6, ' SECONDS.');
  WRITELN('================================');
  WRITELN('SORT CALLED | TIMES');
  WRITELN('------------+-------------------');
  WRITELN('INTRO       | ', INTROS);
  WRITELN('INSERTION   | ', INSERTS);
  WRITELN('HEAP        | ', HEAPS);
  WRITELN('--------------------------------');
END.