
(*  INPUT	: The associated datafile for Transportation problem
		  is called "TransDatafile".

		  "TransDatafile" consists of 
		  1. # of supply nodes,
		  2. # of demand nodes, 
		  3. unit transportation cost  from supply node i
		     to demand node j.
		 
		  FIRST NUMBER in "TransDatafile" is the # of supply
		   nodes, M.

		  SECOND NUMBER is the # of demand nodes, N

		  THIRD set of data represents the amount of supply
		  has for each supply nod i, i = 1 to M.

		  FOURTH ser of data represents the amount of units
		  a demand node j demands, for j = 1 to N.

		  FIFTH set of data is the MxN matrix of transportation
		  costs from supply node i to demand node j.

    Algorithm	: This algorithm uses Ford-Fulkerson method to sovle
		  the transportation problem.

		  Given the data in "TransDatafile",  the objective is
		  to find the minimal shipping cost such that every
		  demand node is satisfied.

		  Maxmum # of supply nodes and maximum # of demand nodes
		  are set to maxsupply = 100, maxdemand = 100 respectively.
		  One can modify them according to their needs.

		  INF is used if supply node i cannot supply for demand
		  node j.  In this case, the shipping cost is set to
		  very large number.  Initially, INF = 1000000;

    OUTPUT	: Outputs are
		  1. Optimal distribution of units from supply node i
		     to demand node j. So, this is a MxN matrix.
		  2. Optimal shipping cost.                           *)

		  


program Transportation (input, output, TransDatafile,TransOutfile);

const	maxsupply	=	100;  
	maxdemand	=	100;  
	INF		=	1000000;

type	CHARFILE	=	file of char;
	ARRMN	=	array[1..maxsupply,1..maxdemand] of integer;
	ARRM	=	array[1..maxsupply] of integer;
	ARRN	=	array[1..maxdemand] of integer;

var	TransDatafile	:	CHARFILE;
        TransOutfile    :	CHARFILE;
	M,N		:	integer;
	A		:	ARRM;
	B		:	ARRN;
	C,X		:	ARRMN;
	KO		:	integer;
	Nextint		:	integer;

procedure Infile(var	N,M	:	integer;
		 var	A	:	ARRM;
		 var	B	:	ARRN;
		 var	C	:	ARRMN;
		 var	Nextint	:	integer);

var row, column : integer;

begin
  reset(TransDatafile);
  readln(TransDatafile,Nextint);
  M := Nextint;
  readln(TransDatafile,Nextint);
  N := Nextint;
  for row := 1 to M do
  begin
    read(TransDatafile,Nextint);
    A[row] := Nextint;
  end;
  readln(TransDatafile);

  for column := 1 to N do
  begin
    read(TransDatafile,Nextint);
    B[column] := Nextint;
  end;
  readln(TransDatafile);

  for row := 1 to M do
  begin
    for column := 1 to N do
    begin
      read(TransDatafile,Nextint);
      C[row,column] := Nextint;
    end;
    readln(TransDatafile);
  end;
end;


  
procedure TRANSPorT(
        M,N,INF:integer;
   var  A      :ARRM;
   var  B      :ARRN;
   var  C,X    :ARRMN;
   var  KO     :integer);

   var I,J,SF,R,RA  :integer;
       LAB,LAB1,LAB2:boolean;
       U,W,EPS      :ARRM;
       V,K,DEL      :ARRN;
begin                    (* INITIALIZATION OF DUAL varIABLES U and V *)
   for I:=1 to M do U[I]:=0;
   for J:=1 to N do begin
      R:=INF;
      for I:=1 to M do begin
         X[I,J]:=0;  SF:=C[I,J];
         if SF < R then R:=SF
      end;
      V[J]:=R
   end;  (* for J *)
   LAB1:=false;
   repeat  (* until LAB1 *)    (* LAB1 IS true if THE OPTIMAL SOLUTION *)
                               (* HAS BEEN FOUND and false OTHERWISE *)
      for I:=1 to M do begin
         W[I]:=0;  EPS[I]:=A[I]
      end;
      for J:=1 to N do begin
         K[J]:=0;  DEL[J]:=0
      end;
      repeat  (* until LAB *)
         LAB:=true;  LAB2:=true;        (* LABELING ROWS and COLUMNS *)
         I:=0;
         repeat  (* until (I = M) or (LAB2 = false) *)
            I:=I+1;
            SF:=EPS[I];  EPS[I]:=-SF;
            if SF > 0 then begin            (* ROW I BECOMES LABELED *)
               RA:=U[I];  J:=0;            
               repeat  (* until (J = N) or (LAB2 = false) *)
                  J:=J+1;
                  if (DEL[J] = 0) and (V[J]-RA = C[I,J]) then begin
                     K[J]:=I;             (* COLUMN J CAN BE LABELED *)
                     DEL[J]:=SF;  LAB:=false;
                     if B[J] > 0 then begin          (* BREAKTHROUGH *)
                        LAB:=true;  LAB2:=false;
                        SF:=abs(DEL[J]);
                        R:=B[J];
                        if R < SF then SF:=R;
                        B[J]:=R-SF;
                        repeat
                           I:=K[J];  X[I,J]:=X[I,J]+SF;
                           J:=W[I];
                           if J <> 0 then  X[I,J]:=X[I,J]-SF
                        until J = 0;
                        A[I]:=A[I]-SF;  J:=0;
                        repeat
                           J:=J+1;  LAB1:=B[J] <= 0
                        until (J = N) or not LAB1;
                        if LAB1 then begin
                                  (* OPTIMAL SOLUTION HAS BEEN FOUND *)
                           SF:=0;
                           for I:=1 to M do
                              for J:=1 to N do begin
                                 R:=X[I,J];
                                 if R > 0 then SF:=SF+R*C[I,J]
                              end ;
                           KO:=SF
                        end (* if LAB1 *)
                     end  (* if B[J] > 0 *)
                  end  (* if (DEL[J] = 0) ... *)
               until (J = N) or not LAB2
            end  (* if SF > 0 *)
         until (I = M) or not LAB2;
         if not LAB then begin         (* LABELING ROWS FROM COLUMNS *)
            LAB:=true;
            for J:=1 to N do begin
               SF:=DEL[J];
               if SF > 0 then begin
                  for I:=1 to M do
                     if EPS[I] = 0 then begin
                        R:=X[I,J];
                        if R > 0 then begin
                           W[I]:=J;
                           if R <= SF then EPS[I]:=R
                           else EPS[I]:=SF;
                           LAB:=false
                        end  (* if R > 0 *)
                     end;  (* if EPS[I] = 0, for I *)
                  DEL[J]:=-SF
               end (* if SF > 0 *)
            end  (* for J *)
         end  (* if not LAB *)
      until LAB;                                  (* end OF LABELING *)
      if LAB2 then begin                 (* MODifYING DUAL varIABLES *)
         R:=INF;
         for I:=1 to M do
            if EPS[I] <> 0 then begin
               RA:=U[I];
               for J:=1 to N do
                  if DEL[J] = 0 then begin
                     SF:=C[I,J]+RA-V[J];
                     if R > SF then R:=SF
                  end
            end;  (* if EPS[I] <> 0, for I *)
         for I:=1 to M do if EPS[I] = 0 then U[I]:=U[I]+R;
         for J:=1 to N do if DEL[J] = 0 then V[J]:=V[J]+R
      end  (* if LAB2 *)
   until LAB1
end;  (* TRANSPorT *)


procedure Outfile(X	:	ARRMN;
		  M,N	:	integer;
		  KO	:	integer);

var row,column : integer;

begin
  rewrite(TransOutfile);
  writeln(TransOutfile,'  The optimal solution obtained for transportation problem is   ');
  for row := 1 to M do
  begin
    for column := 1 to N do
    begin
      write(TransOutfile,X[row,column]);
    end;
    writeln(TransOutfile);
  end;
  writeln(TransOutfile);
  writeln(TransOutfile,'Optimal shipping cost is ',KO);
end;



begin (* main *)
  Infile(N,M,A,B,C,Nextint);
  TRANSPorT(M,N,INF,A,B,C,X,KO);
  Outfile(X,M,N,KO);
end.
