(*		Branch and bound Algorithm 
			for
		Travelling Salesman Problem

	INPUT	:  The assoicated datafile is "BabtspDatafile"
	           1st # represents  number of nodes in a given network
		   2nd set of numbers represents a NxN weight matrix
			of the given network.

	OUTPUT	:  Outputs from this algorithm are
		   1. Find the optimal route for travelling salesman
			problem from starting node 1.
		   2. Determine the total weight of the optimal route.

	Algorithm :  The branch and bound algorithm is method of 
		     exhuastive search.  In a worse-case input, one may
		     end up examining all possible solutions. Therefore,
		     for an n-city assymmetric TSP, there are (n-1)!
		     distinct Hamiltonian cycles.  The worst-case time 
		     complexity of this algorithm could be as bad as
		     O(n!).
		     The execution time of this branch and bound grows
		     with the size of the network.  It is quite expensive
		     to obtain an exact solution of the TSP problems for
		     network with nodes much larger than 40.

	Assumption : The given network is directed graph
							*)


program BranchAndBound(input,output,BabtspDatafile,BabtspOutfile);

const	maxvar = 50;

type	CHARFILE = file of char;
 	ARRN = array [1..maxvar] of integer;
	ARRNN = array [1..maxvar,1..maxvar] of integer;

var	N : integer;
	Nextint : integer;
	INF : integer;
	W : ARRNN;
	ROUTE : ARRN;
	TWEIGHT : integer;
	BabtspDatafile : CHARFILE;
	BabtspOutfile  : CHARFILE;


procedure Infile (var N : integer;
		  var INF : integer;
	   	  var W : ARRNN;
		  var Nextint : integer);

var row, column : integer;

begin
  reset (BabtspDatafile);
  readln (BabtspDatafile, Nextint);
  N := Nextint;
  readln (BabtspDatafile, Nextint);
  INF := Nextint;
  for row := 1 to N do
  begin
    for column := 1 to N do
    begin
      read (BabtspDatafile, Nextint);
      W[row,column] := Nextint;
    end;
    readln(BabtspDatafile);
  end;
end;


procedure BABTSP(
       N,INF  :integer;
   var W      :ARRNN;
   var ROUTE  :ARRN;
   var TWEIGHT:integer);

   var BACKPTR,BEST,COL,FWDPTR,ROW:ARRN;
       I,INDEX                    :integer;

   procedure EXPLORE(EDGES,COST:integer;var ROW,COL:ARRN);
      var AVOID,C,COLROWVAL,FIRST,I,J,
          LAST,LOWERBOUND,MOST,R,SIZE :integer;
          COLRED,NEWCOL,NEWROW,ROWRED :ARRN;

      function MIN(I,J:integer):integer;
      begin
         if I <= J then MIN:=I else MIN :=J
      end;  { MIN }

      function REDUCE(var ROW,COL,ROWRED,COLRED:ARRN):integer;
         var I,J,RVALUE,TEMP:integer;
      begin
         RVALUE:=0;
         for I:=1 to SIZE do begin                    { REDUCE ROWS }
            TEMP:=INF;
            for J:=1 to SIZE do TEMP:=MIN(TEMP,W[ROW[I],COL[J]]);
            if TEMP > 0 then begin
               for J:=1 to SIZE do
                  if W[ROW[I],COL[J]] < INF then
                     W[ROW[I],COL[J]]:=W[ROW[I],COL[J]]-TEMP;
               RVALUE:=RVALUE+TEMP
            end;
            ROWRED[I]:=TEMP
         end;  { for I }
         for J:=1 to SIZE do begin                 { REDUCE COLUMNS }
            TEMP:=INF;
            for I:=1 to SIZE do TEMP:=MIN(TEMP,W[ROW[I],COL[J]]);
            if TEMP > 0 then begin
               for I:=1 to SIZE do
                  if W[ROW[I],COL[J]] < INF then
                     W[ROW[I],COL[J]]:=W[ROW[I],COL[J]]-TEMP;
               RVALUE:=RVALUE+TEMP
            end;
            COLRED[J]:=TEMP
         end;  { for J }
         REDUCE:=RVALUE
      end;  { REDUCE }

      procedure BESTEDGE(var R,C,MOST:integer);
         var I,J,K,MINCOLELT,MINROWELT,ZEROES:integer;
      begin
         MOST:=-INF;
         for I:=1 to SIZE do
            for J:=1 to SIZE do
               if W[ROW[I],COL[J]] = 0 then begin
                  MINROWELT:=INF;  ZEROES:=0;
                  for K:=1 to SIZE do
                     if W[ROW[I],COL[K]] = 0 then ZEROES:=ZEROES+1
                     else MINROWELT:=MIN(MINROWELT,W[ROW[I],COL[K]]);
                  if ZEROES > 1 then MINROWELT:=0;
                  MINCOLELT:=INF;  ZEROES:=0;
                  for K:=1 to SIZE do
                     if W[ROW[K],COL[J]] = 0 then ZEROES:=ZEROES+1
                     else MINCOLELT:=MIN(MINCOLELT,W[ROW[K],COL[J]]);
                  if ZEROES > 1 then MINCOLELT:=0;
                  if (MINROWELT+MINCOLELT) > MOST then begin
                                     { A BETTER EDGE HAS BEEN FOUND }
                     MOST:=MINROWELT+MINCOLELT;
                     R:=I;  C:=J
                  end
               end  { if W[ROW[I],COL[J]] = 0, for J, I }
      end;  { BESTEDGE }

   begin                                          { BODY OF EXPLORE }
      SIZE:=N-EDGES;
      COST:=COST+REDUCE(ROW,COL,ROWRED,COLRED);
      if COST < TWEIGHT then
         if EDGES = (N-2) then begin    { LAST TWO EDGES ARE forCED }
            for I:=1 to N do BEST[I]:=FWDPTR[I];
            if W[ROW[1],COL[1]] = INF then AVOID:=1
            else AVOID:=2;
            BEST[ROW[1]]:=COL[3-AVOID];  BEST[ROW[2]]:=COL[AVOID];
            TWEIGHT:=COST
         end  { if EDGES = (N-2) }
         else begin
            BESTEDGE(R,C,MOST);
            LOWERBOUND:=COST+MOST;
            FWDPTR[ROW[R]]:=COL[C];  BACKPTR[COL[C]]:=ROW[R];
            LAST:=COL[C];                          { PREVENT CYCLES }
            while FWDPTR[LAST] <> 0 do LAST:=FWDPTR[LAST];
            FIRST:=ROW[R];
            while BACKPTR[FIRST] <> 0 do FIRST:=BACKPTR[FIRST];
            COLROWVAL:=W[LAST,FIRST];  W[LAST,FIRST]:=INF;
            for I:=1 to R-1 do NEWROW[I]:=ROW[I];      { REMOVE ROW }
            for I:=R to SIZE-1 do NEWROW[I]:=ROW[I+1];
            for I:=1 to C-1 do NEWCOL[I]:=COL[I];      { REMOVE COL }
            for I:=C to SIZE-1 do NEWCOL[I]:=COL[I+1];
            EXPLORE(EDGES+1,COST,NEWROW,NEWCOL);
            W[LAST,FIRST]:=COLROWVAL;     { RESTORE PREVIOUS VALUES }
            BACKPTR[COL[C]]:=0;  FWDPTR[ROW[R]]:=0;
            if LOWERBOUND < TWEIGHT then  begin
               W[ROW[R],COL[C]]:=INF;
               EXPLORE(EDGES,COST,ROW,COL);
               W[ROW[R],COL[C]]:=0
            end
         end;  { else: EDGES < N-2 }
      for I:=1 to SIZE do                         { UNREDUCE MATRIX }
         for J:=1 to SIZE do
            W[ROW[I],COL[J]]:=W[ROW[I],COL[J]]+ROWRED[I]+COLRED[J]
   end;  { EXPLORE }

begin                                                   { MAIN BODY }
   for I:=1 to N do begin
      ROW[I]:=I;  COL[I]:=I;
      FWDPTR[I]:=0;  BACKPTR[I]:=0
   end;
   TWEIGHT:=INF;
   EXPLORE(0,0,ROW,COL);
   INDEX:=1;
   for I:=1 to N do begin
      ROUTE[I]:=INDEX;  INDEX:=BEST[INDEX]
   end
end;  { BABTSP }


procedure Outfile (ROUTE : ARRN;
		   TWEIGHT : integer);

var count : integer;

begin
  rewrite(BabtspOutfile);
  writeln (BabtspOutfile,'The route for tsp is path');
  for count := 1 to N do
  begin
    write (BabtspOutfile,ROUTE[count]);
  end;
  writeln(BabtspOutfile);
  writeln (BabtspOutfile,'with total weight of ',TWEIGHT);
end;



begin (* main *)
  Infile (N,INF,W,Nextint);
  BABTSP(N,INF,W,ROUTE,TWEIGHT);
  Outfile (ROUTE,TWEIGHT);
end.