
(*                              Hu's Algorithm for Scheduling problems
                                (LevelScheduling Algorithm)
        INPUT           : The associated datafile for this algorithm is 
                          "LevelDatafile"

                          1st number represents # of machines (M).
                          2nd number represents # of tasks (N).
                          3rd set of nubmers represents [1..N+1] array of
                                pointers in backward star form.
                          4th set of numbers represents [1..N-1] array of
                                arcs in backward star form.


        OUTPUT  : Output is
                          1. SCHEDULE[1..N]  array of schedule times;
                             SCHEDULE[J] is the time unit to which task
                             J has been assigned in the optimal solution 
                             found by the procedure.

        Algorithm       : The Hu's Algorithm finds an optimal schedule of N
                          tasks on M machines subject to procedence constraint.
                          The tasks are assumed to have unit processing times a\
nd 
                          the precedence constraints are restricted to those
                          that form trees.  The precedence constraints are
                          assumed to be given in a backward-star form, in which
                          arcs are grouped according to their termial nodes.
                                                                          *)  

program Hu_Level_Scheduling (input,output,LevelDatafile,LevelOutfile);

const	maxtask = 50;
	maxmachine = 50;

type	CHARFILE = file of char;
	ARRN = array [1..maxtask] of integer;
	ARRN1 = array [1..maxtask+1] of integer;
        ARRN2 = array [1..maxtask-1] of integer;

var	M : integer;
	N : integer;
	NRI : ARRN1;
	INARC : ARRN2;
	SCHEDULE : ARRN;
	LevelDatafile : CHARFILE;
	LevelOutfile  : CHARFILE;
	Nextint : integer;



procedure Infile (var M : integer;
		  var N : integer;
		  var NRI : ARRN1;
		  var INARC : ARRN2;
		  var Nextint : integer);

var counter : integer;

begin
  reset (LevelDatafile);
  readln (LevelDatafile,Nextint);
  M := Nextint;
  readln (LevelDatafile,Nextint);
  N := Nextint;
  for counter := 1 to N+1 do
  begin
    read (LevelDatafile,Nextint);
    NRI[counter] := Nextint;
  end;
  readln (LevelDatafile);
  for counter := 1 to N-1 do
  begin
    read (LevelDatafile,Nextint);
    INARC[counter] := Nextint;
  end;
  readln (LevelDatafile);
end;




procedure LEVELSCHEDULING(
       M,N     :integer;
   var NRI     :ARRN1;
   var INARC   :ARRN2;
   var SCHEDULE:ARRN);

   var I,J,L,P,R,S,T,U,V       :integer;
       FATHER,INDEG,LEVEL,LIST,
       OUTDEG,READY,TIME,SETLAB:ARRN;
       NRO                     :ARRN1;
       OUTARC                  :ARRN2;

   procedure OUTARCREP(var OUTDEG:ARRN;var NRO:ARRN1;
                       var OUTARC:ARRN2);
      { THIS procedure CONSTRUCTS FORWARD-STAR REPRESENTATION }
      var I,J,K,L:integer;
          AUX    :ARRN;
   begin
      for I:=1 to N do NRO[I]:=0;
      for J:=1 to N do
         for L:=NRI[J] to NRI[J+1]-1 do begin
            I:=INARC[L];  NRO[I]:=NRO[I]+1
         end;
      J:=1;
      for I:=1 to N do begin
         L:=NRO[I];  OUTDEG[I]:=L;
         NRO[I]:=J;  AUX[I]:=J;
         J:=J+L
      end;
      NRO[N+1]:=J;
      for J:=1 to N do
         for L:=NRI[J] to NRI[J+1]-1 do begin
            I:=INARC[L];  K:=AUX[I];
            OUTARC[K]:=J;  AUX[I]:=K+1
         end
   end;  { OUTARCREP - FORWARD-STAR REPRESENTATION }

   procedure LEVELLIST(var LEVEL,LIST:ARRN);
      { THIS procedure EVALUATES NODE LEVELS AND ORDERS
        NODES ACCORDING TO NONINCREASING LEVEL }
      var I,J,K,L,LEV,P,Q:integer;
          AUX            :ARRN;
   begin
      for I:=1 to N do AUX[I]:=OUTDEG[I];
      P:=N;
      for I:=1 to N do
         if AUX[I] = 0 then begin
            LEVEL[I]:=1;  LIST[P]:=I;
            P:=P-1
         end;
      Q:=N;
      while (P > 0) and (P < Q) do begin
         J:=LIST[Q];  Q:=Q-1;
         LEV:=LEVEL[J]+1;
         for L:=NRI[J] to NRI[J+1]-1 do begin
            I:=INARC[L];  K:=AUX[I]-1;
            if K <> 0 then AUX[I]:=K
            else begin
               LEVEL[I]:=LEV;  LIST[P]:=I;
               P:=P-1
            end
         end  { for L }
      end  { while (P > 0) ... }
   end;  { LEVELLIST }

   function FIND(I:integer):integer;
      { THIS FUNCTION FINDS THE SET CONTAINING I }
      var PTR,X,Y:integer;
   begin
      PTR:=I;
      while FATHER[PTR] > 0 do PTR:=FATHER[PTR];
      X:=I;
      while FATHER[X] > 0 do begin
         Y:=FATHER[X];  FATHER[X]:=PTR;
         X:=Y
      end;
      FIND:=PTR
   end;  { FIND }

   procedure MERGE(U,V :integer);
      { THIS procedure MERGES TWO SETS U AND V }
      var X:integer;
   begin
      X:=FATHER[U]+FATHER[V];
      if FATHER[U] > FATHER[V] then begin
         FATHER[U]:=V;  FATHER[V]:=X
      end
      else begin
         FATHER[V]:=U;  FATHER[U]:=X;
         SETLAB[U]:=SETLAB[V]
      end
   end;  { MERGE }

begin                                                   { MAIN BODY }
   OUTARCREP(OUTDEG,NRO,OUTARC);
   LEVELLIST(LEVEL,LIST);
   for I:=1 to N do begin
      INDEG[I]:=NRI[I+1]-NRI[I];
      FATHER[I]:=-1;  SETLAB[I]:=I;
      TIME[I]:=M
   end;  { for I }
   for I:=1 to N do  READY[I]:=1;
   P:=1;
   while P <= N do begin
      I:=LIST[P];   P:=P+1;                     { PROCESSING NODE I }
      T:=READY[I];  U:=FIND(T);
      R:=SETLAB[U];  SCHEDULE[I]:=R;
      S:=TIME[R]-1;
      if S > 0 then TIME[R]:=S
      else begin
         V:=FIND(R+1);  MERGE(U,V)
      end;
      for L:=NRO[I] to NRO[I+1]-1 do begin
         J:=OUTARC[L];  INDEG[J]:=INDEG[J]-1;
         if READY[J] < R+1 then READY[J]:=R+1
      end
   end  { while P <= N }
end;  { LEVELSCHEDULING }



procedure Outfile (SCHEDULE : ARRN);

var counter : integer;

begin
  rewrite(LevelOutfile);
  writeln (LevelOutfile,'The solution obtained using Hu Level_Scheduling Algorithm ');
  writeln(LevelOutfile);
  writeln(LevelOutfile,'The time unit to which task J for J = 1..N assigned in the optimal solution is  ');
  for counter := 1 to N do
  begin
    writeln (LevelOutfile,'SCHEDULE[',counter:3,' ]',SCHEDULE[counter]);
  end;
  writeln(LevelOutfile);
end;




begin (* main *)
  Infile (M,N,NRI,INARC,Nextint);
  LEVELSCHEDULING(M,N,NRI,INARC,SCHEDULE);
  Outfile(SCHEDULE);
end.