program priority_q_demo (infile1,output);

  {The program first arranges the input data into a heap with the lowest
   value as the root. Several insertions and deletions are made (deletion
   is always of the lowest value data item) with the heap property restored
   after each operation. Finally, the array (which contains the heap) is
   printed.

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      LIST ADT (an ARRAY implementataion)

NOTES:-    1. The array size is determined by maxln, and is set for 100
              elements.

           2. An empty list has the position variable L.last set to 0.}


const
  maxln = 100;
type
  position = integer;
  infotype = integer;
  list = record
           contents: array[1..maxln] of infotype;
           last: position
         end;
  processtype = infotype;
  PRIORITYQUEUE = list;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1: text;
  L: list;
  dummy: processtype;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

              LIST ADT    -   CODE}

procedure ERROR;
  begin
  { * * COMPILER SPECIFIC FEATURE FOLLOWS * *}
  abort('ERROR',0,0);
  { * * END CSF * *}
  end;
function FIRST (var L: list): position;
  begin
    FIRST:= 1
  end;
function ENDLIS (var L: list): position;
  begin
    ENDLIS:= L.last + 1
  end;
function NEXT (p: position; var L: list): position;
  begin
    if ((p > L.last) or (p < 1))
      then
        ERROR
      else
        NEXT:= p + 1
  end;
function RETRIEVE (p: position; var L: list): infotype;
  begin
    if ((p > L.last) or (p < 1))
      then
        ERROR
      else
        RETRIEVE:= L.contents[p]
  end;
procedure MAKENULL (var L: list);
  begin
    L.last:= 0
  end;
procedure INSERTL (x: infotype; p: position; var L: list);
  var
    q: position;
  begin
    if L.last >= maxln
      then
        ERROR
      else
        if ((p > L.last+1) or (p < 1))
          then
            ERROR
          else
            begin
              for q:=L.last downto p do
                L.contents[q+1]:= L.contents[q];
              L.last:= L.last+1;
              L.contents[p]:= x
            end
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

            PRIORITY QUEUE ADT    -   CODE}

procedure DELETEMIN (var element: processtype; var A: PRIORITYQUEUE);
  var
    i, j: integer;
    temp: processtype;
    done: boolean;
  begin
    if A.last = 0
      then
        ERROR
      else
        begin
          done:= false;
          element:= A.contents[1];
          A.contents[1]:= A.contents[A.last];
          A.last:= A.last - 1;
          i:= 1;
          while ((i <= A.last div 2) and (not done)) do
            begin
              if 2*i = A.last
                then
                  j:= 2*i
                else
                  if A.contents[2*i] < A.contents[2*i+1]
                    then
                      j:= 2*i
                    else
                      j:= 2*i+1;
              if A.contents[i] > A.contents[j]
                then
                  begin
                    temp:= A.contents[i];
                    A.contents[i]:= A.contents[j];
                    A.contents[j]:= temp;
                    i:= j
                  end
                else
                  done:= true
            end
        end
  end;
procedure INSERT (x: processtype; var A: PRIORITYQUEUE);
  var
    i: integer;
    temp: processtype;
    done: boolean;
  begin
    if A.last >= maxln
      then
        ERROR
      else
        begin
          A.last:= A.last + 1;
          A.contents[A.last]:= x;
          i:= A.last;
          done:= false;
          while ((i>1) and (not done)) do
            if A.contents[i] < A.contents[i div 2]
              then
                begin
                  temp:= A.contents[i];
                  A.contents[i]:= A.contents[i div 2];
                  A.contents[i div 2]:= temp;
                  i:= i div 2
                end
              else
                done:= true
        end
  end;

procedure MAKEHEAP (var A: PRIORITYQUEUE);
  var
    c: integer;
  procedure buildheap (i: integer; var A:PRIORITYQUEUE);
    var
      done: boolean;
      temp: processtype;
      j: integer;
    begin
      done:= false;
      while ((i <= A.last div 2) and (not done)) do
        begin
          if 2*i = A.last
            then
              j:= 2*i
            else
              if A.contents[2*i] < A.contents[2*i+1]
                then
                  j:= 2*i
                else
                  j:= 2*i+1;
          if A.contents[i] > A.contents[j]
            then
              begin
                temp:= A.contents[i];
                A.contents[i]:= A.contents[j];
                A.contents[j]:= temp;
                i:= j
              end
            else
              done:= true
        end
    end;
  begin
    for c:= A.last div 2 downto 1 do
      buildheap (c, A)
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure read_in (var f: text; var L: list);
    {read_in reads the input text file and puts the elements in list L. One
     single digit integer per line is the expected file format.}
  var
    p: position;
    v: infotype;
  begin
    p:= FIRST(L);
    while not eof(f) do
      begin
        readln (f,v);
        INSERTL (v, p, L);
        p:= NEXT(p, L)
      end
  end;

procedure print_out (var L: list);
    {print_out prints list L, after a linefeed. The elements are expected to be
     single digit integers (a field width of 2 is used with no formatting) if
     this is not the case the output will look confused.}
  var
    p: position;
  begin
    writeln;
    p:= FIRST(L);
    while p <> ENDLIS(L) do
      begin
        write (RETRIEVE(p, L):3);
        p:= NEXT(p, L)
      end
  end;


{     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

begin
  reset(infile1);
  MAKENULL(L);
  read_in (infile1, L);
  print_out (L);
  MAKEHEAP (L);
  INSERT (2, L);
  DELETEMIN (dummy, L);
  INSERT (12, L);
  INSERT (9, L);
  DELETEMIN (dummy, L);
  DELETEMIN (dummy, L);
  DELETEMIN (dummy, L);
  INSERT (17, L);
  INSERT (4, L);
  print_out (L);
end.