(*                              Network Scheduling Problems

        INPUT           :  The associated datafile for Network Scheduling
                           problem is NetworkDatafile.
                           1st number represents # of nodes (N)in the network.
                           2nd number represents the maximal integer number
                                available in the system that is used.
                           3rd set of numbers represents [1..N+1] array of
                                pointers in a backward-star form.
                           4th set of numbers represents [1..M] array of arc
                                initial nodes.
                           5th set of numbers represent [1..N] array of
                                pointers to the last conjuctive arcs.
                           6th set of numbers represents [1..N] array of an
                                initial topological ordering of nodes.
                           7th set of numbers represents [1..N] array of
                                processing time.

        OUTPUT  :  Outputs are
                                1.  ORDER[1..N], array containing a topological
                                    ordering of the nodes in the solution.
                                2.  LONGESTPATH[1..N], array of the earlist
                                    possible starting times of activities in
                                    the solution.
                                3.  COUNT, number of feasible networks
                                    generated by the procedure.

        Algorithm       :  The algorithm is pased on  Balas's Implicit
                           Enumeration Algorithm for Network Scheduling.
                           A backward-star form is used to represent the
                           entire disjunctive network G(D).
								*)


program Balas_Network_Scheduling (input,output,NetworkDatafile,NetworkOutfile);

const	maxvar = 50;
	maxarc = 100;
	MAX = maxarc * maxarc;

type	CHARFILE = file of char;
	ARRN = array [1..maxvar] of integer;
	ARRN1 = array [1..maxvar+1] of integer;
	ARRM = array [1..maxarc] of integer;
	ARRMAX = array [1..MAX] of integer;

var 	N : integer;
	INF : integer;
	NR : ARRN1;
	INARC : ARRM;
	NRC : ARRN;
	ORDER : ARRN;
	TIME : ARRN;
	LONGESTPATH : ARRN;
	COUNT : integer;
	NetworkDatafile : CHARFILE;
        NetworkOutfile  : CHARFILE;
	Nextint : integer;
	M : integer;



procedure Infile (var N : integer;
		  var INF : integer;
		  var NR : ARRN1;
		  var M : integer;
		  var INARC : ARRM;
		  var NRC : ARRN;
		  var ORDER : ARRN;
		  var TIME : ARRN;
		  var Nextint : integer);

var counter : integer;

begin
  reset (NetworkDatafile);
  readln (NetworkDatafile,Nextint);
  N := Nextint;
  readln (NetworkDatafile,Nextint);
  INF := Nextint;
  for counter := 1 to N+1 do
  begin
    read (NetworkDatafile,Nextint);
    NR[counter] := Nextint;
  end;
  readln (NetworkDatafile);
  readln (NetworkDatafile,Nextint);
  M := Nextint;
  for counter := 1 to M do
  begin
    read (NetworkDatafile,Nextint);
    INARC[counter] := Nextint;
  end;
  readln (NetworkDatafile);
  for counter := 1 to N do
  begin
    read (NetworkDatafile,Nextint);
    NRC[counter] := Nextint;
  end;
  readln (NetworkDatafile);
  for counter := 1 to N do
  begin
    read (NetworkDatafile,Nextint);
    ORDER[counter] := Nextint;
  end;
  readln (NetworkDatafile);
  for counter := 1 to N do
  begin
    read (NetworkDatafile,Nextint);
    TIME[counter] := Nextint;
  end;
  readln (NetworkDatafile);
end;





procedure NETWORKSCHEDULING(
       N,INF         :integer;
   var NRC,ORDER,TIME:ARRN;
   var NR            :ARRN1;
   var INARC         :ARRM;
   var COUNT         :integer;
   var LONGESTPATH   :ARRN);

   var DELTA,I,I1,J,K,L,P,Q,R,S,T,T1,T2:integer;
       B,BACK                          :boolean;
       D,DELARR,E,F,OPTORD,PI,REVORD   :ARRN;
       LABELS,LL,MATE,TREE,UL          :ARRM;
       CRITARC                         :ARRMAX;

   procedure DMATES;
      { THIS procedure MATCHES DISJUNCTIVE ARCS OF THE SAME PAIR }
      var I,J,K,L:integer;
   begin
      for I:=1 to N do begin
         PI[I]:=NRC[I]+1;  D[I]:=PI[I];
         E[I]:=NR[I+1]-1
      end;
      for I:=1 to N do
         for K:=PI[I] to E[I] do  begin
            J:=INARC[K];  L:=D[J];
            LABELS[L]:=I;  CRITARC[L]:=K;
            D[J]:=L+1
         end;  { for K, I }
      for I:=1 to N do begin
         for K:=PI[I] to E[I] do D[LABELS[K]]:=CRITARC[K];
         for K:=PI[I] to E[I] do MATE[K]:=D[INARC[K]]
      end
   end;  { DMATES }

   procedure CRITICALPATH(LAB:integer;var D,E:ARRN);
      { THIS procedure FINDS THE LENGHT OF LONGEST PATHS
        FROM SOURCE TO ALL OTHER NODES IN THE NETWORK
        forMED BY ARCS WITH LABELS AT LEAST LAB }
      var H,I,J,K,L,R,S:integer;
   begin
      D[1]:=0;
      for K:=2 to N do begin
         J:=ORDER[K];
         R:=-1;
         for L:=NR[J] to NR[J+1]-1 do
            if LABELS[L] >= LAB then begin
               I:=INARC[L];  S:=D[I]+TIME[I];
               if S > R then begin R:=S;  H:=L end
            end;
         D[J]:=R;  E[J]:=H
      end  { for K }
   end;  { CRITICALPATH }

   procedure REORDER(I,J:integer);
      { THIS procedure MODIFIES TOPOLOGICAL ORDERING AFTER
        SWITCHING DISJUNCTIVE ARC (I,J) for ITS REVERSE }
      var K,L,P,Q,R,S,U,V:integer;
          NODORD         :ARRN;

      procedure MOVE(var G,H:integer);
         { THIS procedure MOVES NODE G TO POSITION H IN ARRAY ORDER }
      begin
         ORDER[H]:=G;  REVORD[G]:=H;  H:=H-1
      end;  { MOVE }

   begin
      K:=REVORD[I];  L:=REVORD[J];
      ORDER[L]:=-J;
      Q:=L;
      while Q > K+1 do begin
         R:=ORDER[Q];
         if R < 0 then
            for U:=NR[-R] to NR[-R+1]-1 do begin
               S:=INARC[U];  V:=REVORD[S];
               if (V > K) and (LABELS[U] >= 2) then ORDER[V]:=-S
            end;  { for U, if R < 0 }
         Q:=Q-1
      end;  { while Q > K+1 }
      P:=0;
      for U:=K+1 to L do
         if ORDER[U] < 0 then begin
            P:=P+1;  NODORD[P]:=-ORDER[U]
         end;
      Q:=L;
      for U:=L-1 downto K do
          if ORDER[U] > 0 then MOVE(ORDER[U],Q);
      for U:=P downto 1 do MOVE(NODORD[U],Q)
   end;  { REORDER }

begin                                                   { MAIN BODY }
   DMATES;                                         { INITIALIZATION }
   for I:=1 to N do REVORD[ORDER[I]]:=I;
   for I:=1 to N do begin                          { SETTING LABELS }
      for J:=NR[I] to NRC[I] do LABELS[J]:=3;
      P:=REVORD[I];
      for J:=NRC[I]+1 to NR[I+1]-1 do begin
         Q:=REVORD[INARC[J]];
         if P > Q then LABELS[J]:=2
         else LABELS[J]:=1
      end  { for J }
   end;  { for I }
   R:=0;                 { R IS THE LEVEL NUMBER IN THE SEARCH TREE }
   K:=0;  T:=INF;  COUNT:=0;
   repeat  { R = 0 }               { until THE SEARCH IS EXCHAUSTED }
      CRITICALPATH(3,D,E);
      BACK:=D[N] >= T;
      B:=TRUE;
      if not BACK then begin
         CRITICALPATH(2,PI,E);
         if PI[N] < T then begin       { UPDATING THE BEST SOLUTION }
            for I:=1 to N do OPTORD[I]:=ORDER[I];
            T:=PI[N]
         end;
         J:=N;  L:=K+1;
         while J <> 1 do begin
            I1:=E[J];  I:=INARC[I1];
            if LABELS[I1] = 2 then begin
                                { ARC (I,J) IS DISJUNCTIVE and FREE }
               LABELS[I1]:=1;
               CRITICALPATH(2,D,F);    { LONGEST PATH WITH NO (I,J) }
               LABELS[I1]:=2;
               T1:=D[J]-PI[I];  T2:=D[N]-D[I]-PI[N]+PI[J];
               DELTA:=T1+T2+TIME[J];
               if T1 > DELTA then DELTA:=T1;
               if T2 > DELTA then DELTA:=T2;
               DELTA:=DELTA-TIME[I];
               P:=L;  Q:=1;
               while (P <= K) and (DELARR[Q] <= DELTA) do begin
                  P:=P+1;   Q:=Q+1
               end;
               K:=K+1;  Q:=K-L+1;
               for S:=K downto P+1 do begin
                  CRITARC[S]:=CRITARC[S-1];
                  DELARR[Q]:=DELARR[Q-1];
                  Q:=Q-1
               end;  { for S }
               CRITARC[P]:=I1;  DELARR[Q]:=DELTA
            end;  { if LABELS[I1] = 2 - FREE ARC (I,J) }
            J:=I
         end;  { while J <> 1 - TRAVERSING CRITICAL PATH }
         B:=L > K;
         if not B then begin
            R:=R+1;  LL[R]:=L;  UL[R]:=K
         end
      end;  { if not BACK }
      if BACK or B then
         while B and (R > 0) do begin           { BACKTRACKING STEP }
            P:=TREE[R];  Q:=MATE[P];
            LABELS[P]:=1;  LABELS[Q]:=4;
            REORDER(INARC[P],INARC[Q]);
            B:=LL[R] > UL[R];
            if B then begin
               R:=R-1;
               if R > 0 then
                  for S:=UL[R]+1 to UL[R+1] do LABELS[CRITARC[S]]:=2
            end  { if B }
         end;  { while B and (R > 0), if BACK OR B }
      if R > 0 then begin                            { forvarD MOVE }
         K:=UL[R];
         COUNT:=COUNT+1;  I1:=LL[R];
         P:=CRITARC[I1];  LL[R]:=I1+1;  Q:=MATE[P];
         LABELS[Q]:=3;  LABELS[P]:=0;
         REORDER(INARC[P],INARC[Q]);
         TREE[R]:=Q
      end  { if R > 0 }
   until R = 0;
   for I:=1 to N do begin                { OUTPUT THE BEST SOLUTION }
      ORDER[I]:=OPTORD[I];  REVORD[ORDER[I]]:=I
   end;
   for I:=1 to N do begin
      P:=REVORD[I];
      for J:=NRC[I]+1 to NR[I+1]-1 do begin
         Q:=REVORD[INARC[J]];
         if P > Q then LABELS[J]:=2
         else LABELS[J]:=1
      end  { for J }
   end;  { for I }
   CRITICALPATH(2,LONGESTPATH,E)
end;  { NETWORKSCHEDULING }



procedure Outfile (COUNT : integer;
		   ORDER : ARRN;
		   LONGESTPATH : ARRN);

var counter : integer;

begin
  rewrite(NetworkOutfile);
  writeln (NetworkOutfile,' Solution obtained using Balas Network Scheduling is ');
  writeln(NetworkOutfile);
  writeln (NetworkOutfile,' Number of feasible networks generated by the procedure is ',COUNT);
  writeln(NetworkOutfile);
  writeln (NetworkOutfile,'The ordering of the nodes in the solution is ');
  for counter := 1 to N do
  begin
    write (NetworkOutfile,ORDER[counter]:3);
  end;
  writeln(NetworkOutfile);
  writeln(NetworkOutfile);
  writeln (NetworkOutfile,'The earlist possible starting times of activities in the solution is ');
  for counter := 1 to N do
  begin
    write (NetworkOutfile,LONGESTPATH[counter]:3);
  end;
  writeln(NetworkOutfile);
end;



begin (* main *)
  Infile (N,INF,NR,M,INARC,NRC,ORDER,TIME,Nextint);
  NETWORKSCHEDULING (N,INF,NRC,ORDER,TIME,NR,INARC,COUNT,LONGESTPATH);
  Outfile (COUNT,ORDER,LONGESTPATH);
end.