
(*		THIS IS A ZERO-ONE INTEGR PROGRAMMING ALGORITHM

   INPUT	: The associated datafile for 0-1 integer problem is
		  called "BalasDatafile".

		  BalasDatafile consists of
	  	  1. # of variables, N,
		  2. # of constraints, M,
		  3. Constraint Matrix A (MxN)
		  4. Right Hand Side(RHS) values, vector b,
		  5. Cost vector of the objective function.

		  FIRST NUMBER in "BalasDatafile" is the # of variables, N

		  SECOND NUMBER is the # of constraints, M.

		  THIRD set of data represents the constraint matrix A.

		  FOURTH set of data represents RHS, vector b.

		  FIFTH set of data represents Cost vector.


   Algorithm	: This algorithm is based on BALAS branching testing.

		   This algorithm solves the BINARY linear program:
			min  cx
			s.t.
			     Ax <= b
			     x = 0 or 1.

		  Maximum # of variables, and maximum # of constraints are
		  set to maxvar =100 and maxconstraint=50 respectively.
		  One can modify them according to their needs.

		  INF is some large positive integer.

   OUTPUT	: Outputs are
		  1. Check whether or not there exist a solution.
		  2. Determine the optimal basic variables and their
		     corresponding values.
		  3. Determine the optimal value of the objective function


   NOTE		: This algorithm is suitable for problems with
		  number of variables n ranging from 30 to 100 and
		  the density of matrix A equal <= 0.6               

		  This algorithm is not suitble for the following problem.
		  It runs in exponential time.
		  
			min xn+1
			s.t
			    2*(SUM(xj))  + xn+1  = n
		              (j=1 to n)

			    all x are 0 or 1 and 
			    n is an odd positive integer.              *)




program ZeroOne (input,output, BalasDatafile, BalasOutfile);

const	INF	=	999;
	maxvar	=	100;
  	maxconstraint = 50;

type	CHARFILE	=	file of char;
	ARRMN	= array[1..maxconstraint,1..maxvar] of integer;
	ARRM	= array[1..maxconstraint] of integer;
        ARRN	= array[1..maxvar] of integer;
        ARRN1   = array[1..maxvar+1] of integer;

var	N,M,Nextint,N1	:	integer;
	BalasDatafile	:	CHARFILE;
	BalasOutfile    :	CHARFILE;
	A		:	ARRMN;
	B		:	ARRM;
	C,X		:	ARRN;
	FVAL		:	integer;
	EXIST		:	boolean;

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

var row, column : integer;

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

  for row := 1 to M do
  begin
    read(BalasDatafile,Nextint);
    B[row] := Nextint;
  end;
  readln(BalasDatafile);


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



procedure BALAS(
       M,N,INF:integer;
   var A      :ARRMN;
   var B      :ARRM;
   var C,X    :ARRN;
   var FVAL   :integer;
   var EXIST  :boolean);

   label 10,20;
   var ALFA,BETA,GAMMA,I,J,MNR,NR,P,R,R1,R2,S,T,Z:integer;
       Y,W,ZR                                    :ARRM;
       II,JJ,XX                                  :ARRN;
       KK                                        :ARRN1;
begin
   for I:=1 to M do Y[I]:=B[I];
   Z:=1;
   for J:=1 to N do begin
      XX[J]:=0;  Z:=Z+C[J]
   end;
   FVAL:=Z+Z;
   S:=0;  T:=0;  Z:=0;
   KK[1]:=0;
   EXIST:=false;
10:
   P:=0;  MNR:=0;
   for I:=1 to M do begin
      R:=Y[I];
      if R < 0 then begin                 (* INFEASIBLE CONSTRAINT I *)
         P:=P+1;
         GAMMA:=0;  ALFA:=R;  BETA:=-INF;
         for J:=1 to N do
            if XX[J] <= 0 then
               if C[J]+Z >= FVAL then begin
                  XX[J]:=2;
                  KK[S+1]:=KK[S+1]+1;
                  T:=T+1;  JJ[T]:=J
               end  (* if C[J]+Z >= FVAL *)
               else begin
                  R1:=A[I,J];
                  if R1 < 0 then begin
                     ALFA:=ALFA-R1;  GAMMA:=GAMMA+C[J];
                     if BETA < R1 then BETA:=R1
                  end
               end;  (* else: C[J]+Z < FVAL, for J *)
         if ALFA < 0 then goto 20;
         if ALFA+BETA < 0 then begin
            if GAMMA+Z >= FVAL then goto 20;
            for J:=1 to N do begin
               R1:=A[I,J];  R2:=XX[J];
               if R1 < 0 then begin
                  if R2 = 0 then begin
                     XX[J]:=-2;
                     for NR:=1 to MNR do begin
                        ZR[NR]:=ZR[NR]-A[W[NR],J];
                        if ZR[NR] < 0 then goto 20
                     end
                  end  (* if R2 = 0 *)
               end  (* if R1 < 0 *)
               else
                  if R2 < 0 then begin
                     ALFA:=ALFA-R1;
                     if ALFA < 0 then goto 20;
                     GAMMA:=GAMMA+C[J];
                     if GAMMA+Z >= FVAL then goto 20
                  end  (* if R2 < 0, else: R1 >= 0 *)
            end;  (* for J *)
            MNR:=MNR+1;
            W[MNR]:=I;  ZR[MNR]:=ALFA
         end  (* if ALFA+BETA < 0 *)
      end  (* if R < 0 *)
   end;  (* for I *)
   if P = 0 then begin                 (* UPDATING THE BEST SOLUTION *)
      FVAL:=Z;  EXIST:=true;
      for J:=1 to N do
         if XX[J] = 1 then X[J]:=1 else X[J]:=0;
      goto 20
   end;  (* if P = 0 *)
   if MNR = 0 then begin
      P:=0;
      GAMMA:=-INF;
      for J:=1 to N do
         if XX[J] = 0 then begin
            BETA:=0;
            for I:=1 to M do begin
               R:=Y[I];  R1:=A[I,J];
               if R < R1 then BETA:=BETA+R-R1
            end;  (* for I *)
            R:=C[J];
            if (BETA > GAMMA) or (BETA =GAMMA) and (R < ALFA) then
            begin
               ALFA:=R;  GAMMA:=BETA;
               P:=J
            end
         end;  (* if XX[J] = 0 *)
      if P = 0 then goto 20;
      S:=S+1;  KK[S+1]:=0;
      T:=T+1;  JJ[T]:=P;
      II[S]:=1;  XX[P]:=1;
      Z:=Z+C[P];
      for I:=1 to M do Y[I]:=Y[I]-A[I,P]
   end  (* if MNR = 0 *)
   else begin
      S:=S+1;
      II[S]:=0;  KK[S+1]:=0;
      for J:=1 to N do
         if XX[J] < 0 then begin
            T:=T+1;  JJ[T]:=J;
            II[S]:=II[S]-1;
            Z:=Z+C[J];
            XX[J]:=1;
            for I:=1 to M do Y[I]:=Y[I]-A[I,J]
         end;  (* if XX[J] < 0 *)
   end;  (* else: MNR <> 0 *)
   goto 10;
20:                                                  (* BACKTRACKING *)
   for J:=1 to N do if XX[J] < 0 then XX[J]:=0;
   if S > 0 then
      repeat  (* until S = 0 *)
         P:=T;  T:=T-KK[S+1];
         for J:=T+1 to P do XX[JJ[J]]:=0;
         P:=abs(II[S]);
         KK[S]:=KK[S]+P;
         for J:=T-P+1 to T do begin
            P:=JJ[J];  XX[P]:=2;
            Z:=Z-C[P];
            for I:=1 to M do Y[I]:=Y[I]+A[I,P]
         end;  (* for J *)
         S:=S-1;
         if II[S+1] >= 0 then goto 10
      until S = 0
end;  (* BALAS *)


procedure Outfile(X 	: ARRN;
		  N	: integer;
		  FVAL  : integer;
		  EXIST : boolean);

var counter : integer;

begin
 rewrite(BalasOutfile);
 if EXIST = true then
 begin
   writeln (BalasOutfile,'  EXIST = ',EXIST,' And SOLUTION has been found');
   writeln (BalasOutfile,'  Optimal value is ',FVAL,  '   with');
   for counter := 1 to N do
      writeln(BalasOutfile,'  X',counter:2,'  =  ',X[counter]);
 end;
end;

begin
  Infile(M,N,N1,Nextint,A,B,C);
  BALAS(M,N,INF,A,B,C,X,FVAL,EXIST);
  Outfile(X,N,FVAL,EXIST);
end.
