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;

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;

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;

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;

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;

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;

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;

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;

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;

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.