(*                              Set Partitioning Problems

        INPUT   : The associated datafile is "SetpartrDatafile".

                          1st number (M) represents number of elements
                                in the base set.
                          2nd number (N) represents # of subsets in the
                                family P
                          3rd set of numbers A[1..M,1..N], represents
                                array containing the 0-1 constraint matrix
                                of the instance.
                          4th set of numbers SETS[1..N], represents
                                array of N records representing the family
                                of sets P. Each record consists of two fields
                                One is designated to hold the cardinality of
                                a set and the other is a linked list of 
                                the set elements.
                          5th set of numbers SETLISTS[1..M], represents
                                array of M records representing index sets
                                {Fi}. Each record i consists of tw fields;
                                one holds the cardinality of Fi and the
                                other is a linked list of indices of sets
                                which contain element i.
                          6th set of numbers C[1..N], represents array
                                of the costs.

        OUTPUT  : Outputs are
                          1.MR,# of elements of the base set in the
                                reduced problem.
                          2. NR, # of memebers of the family P in the
                                reduced problem.
                          3. NONFEASIBLE,  Boolean variable which has
                                value TRUE if no feasible solution is 
                                found.  FALSE otherwise.
                          4. OPTIMAL,  Boolean variable which has value
                                TRUE if an optimal solution has been found.
                                FALSE otherwise.
                          5. ELCOVER[1..M], array that define the 
                                reduced problem.
                          6. COVER[1..N],  array that define the 
                                reduced problem.
                          7. COST, cost of the partial solution consisting
                                of those sets J for which COVER[J] = 1.

        Algorithm       : The SETPARTRED procedure is an implementation
                                of the reduction algorithm for the set-
                                partitioning problem.  Assume that initially 
                                the base set has M elements and the family
                                of its subsets has N members.
                          Advantage of using the double representation
                                of the problem is
                                1. Matrix elements can be accessed randomly.
                                2. Matrix lines can be compared easily 
                                   element by element.
                                3. The sets {Pj} and the index sets {Fi}
                                   can be scanned in the time proportional
                                   to their cardinalities.  
								*)



program Setpart (input,output,SetpartrDatafile,SetpartrOutfile);

const	maxelement = 50;
	maxsubset = 50;

type	CHARFILE = file of char;
	ARRM = array [1..maxelement] of integer;
	ARRN = array [1..maxsubset] of integer;
	ARRMN = array [1..maxelement, 1..maxsubset] of 0..1;
	POINTEL = ^ELEMENTLIST;
	ELEMENTLIST = record
			ELEM : integer;
			NEXT : POINTEL;
		      end;
	SETDATA = record
		    CARD : integer;
		    LIST : POINTEL;
		  end;
	INDEXSET = array [1..maxelement] of SETDATA;
	SETFAMILY = array [1..maxsubset] of SETDATA;

var	M,N : integer;
	A : ARRMN;
	SETS : SETFAMILY;
	SETLISTS : INDEXSET;
	C : ARRN;
	MR, NR : integer;
	NONFEASIBLE, OPTIMAL : boolean;
	ELCOVER : ARRM;
	COVER : ARRN;
	COST : integer;
	SetpartrDatafile : CHARFILE;
	SetpartrOutfile  : CHARFILE;
	Nextint : integer;


procedure Infile (var M : integer;
		  var N : integer;
		  var A : ARRMN;
		  var SETS : SETFAMILY;
		  var SETLISTS : INDEXSET;
		  var C : ARRN;
		  var Nextint : integer);

var row, column : integer;
    newelement : POINTEL;

begin
  reset (SetpartrDatafile);
  readln (SetpartrDatafile,Nextint);
  M := Nextint;
  readln (SetpartrDatafile,Nextint);
  N := Nextint;
  for row := 1 to M do
  begin
    for column := 1 to N do
    begin
      read (SetpartrDatafile,Nextint);
      A[row,column] := Nextint;
    end;
    readln (SetpartrDatafile);
  end;
  for row := 1 to N do
  begin
    SETS[row].LIST := nil;
    (*    new (SETS[row].LIST); *)
    read (SetpartrDatafile,Nextint);
    SETS[row].CARD := Nextint;
    while not eoln (SetpartrDatafile) do
    begin
      new (newelement);
      read (SetpartrDatafile,Nextint);
      newelement^.ELEM := Nextint;
      newelement^.NEXT := SETS[row].LIST;
      SETS[row].LIST := newelement;
    end; (* while loop *)
    readln (SetpartrDatafile);
  end;
  for row := 1 to M do
  begin
    (*new (SETLISTS[row].LIST);*)
    read(SetpartrDatafile,Nextint);
    SETLISTS[row].CARD := Nextint;
    while not eoln(SetpartrDatafile) do
    begin
      new (newelement);
      read (SetpartrDatafile,Nextint);
      newelement^.ELEM := Nextint;
      newelement^.NEXT := SETLISTS[row].LIST;
      SETLISTS[row].LIST := newelement;
    end; (* while *)
    readln (SetpartrDatafile);
  end;
  for row := 1to N do
  begin
    read (SetpartrDatafile,Nextint);
    C[row] := Nextint;
  end;
  readln (SetpartrDatafile);
end;

procedure SETPARTRED(
       M,N                :integer;
   var MR,NR              :integer;
   var A                  :ARRMN;
   var SETS               :SETFAMILY;
   var SETLISTS           :INDEXSET;
   var C                  :ARRN;
   var NONFEASIBLE,OPTIMAL:boolean;
   var ELCOVER            :ARRM;
   var COVER              :ARRN;
   var COST               :integer);

   var I,J                  :integer;
       BR2,BR3R,BR5,CONTINUE:boolean;
       NSL                  :ARRM;
       NS                   :ARRN;

   function MN:boolean;
   begin               { MN IS true if THE PROBLEM HAS not VANISHED }
      MN:=(MR > 0) and (NR > 0)
   end;  { MN }

   procedure EMPTYSET;
      var I:integer;
   begin                              { EMPTYSET REMOVES EMPTY SETS }
      for I:=1 to N do
         if (COVER[I] = -1) and (NS[I] = 0) then begin
            NR:=NR-1;  COVER[I]:=0
      end
   end;  { EMPTY SET }

   function EMPTYLIST:boolean;
      { EMPTYLIST IS true if IN THE CURRENT PROBLEM SOME
        ELEMENT CANNOT BE COVERED BY ANY SET }
      var I:integer;
          B:boolean;
   begin
      B:=false;  I:=1;
      while not B and (I <= M) do begin
         B:=(NSL[I] = 0) and (ELCOVER[I] = 0);
         I:=I+1
      end;
      EMPTYLIST:=B
   end;  { EMPTY LIST }

   procedure DELETESET(var J,NR:integer;var NSL:ARRM;var COVER:ARRN);
      var L:integer;
          P:POINTEL;
   begin             { THE procedure DELETES SET J FROM THE PROBLEM }
      NR:=NR-1;  COVER[J]:=0;
      P:=SETS[J].LIST;
      while P <> nil do begin
         L:=P^.ELEM;
         NSL[L]:=NSL[L]-1;
         P:=P^.NEXT
      end;
   end;  { DELETE SET J }

   procedure SPRED2(var BR2:boolean);
      var I,K,L,T:integer;
          P,Q    :POINTEL;
   begin                         { REDUCTION 2 - ROWS WITH SINGLE 1 }
      BR2:=false;
      for I:=1 to M do
         if (ELCOVER[I] = 0) and (NSL[I] = 1) then begin
            BR2:=true;  MR:=MR-1;
            ELCOVER[I]:=1;
            P:=SETLISTS[I].LIST;
            repeat
               T:=P^.ELEM;  P:=P^.NEXT
            until COVER[T] = -1;
            NR:=NR-1;
            COVER[T]:=1;  COST:=COST+C[T];
            P:=SETS[T].LIST;
            while P <> nil do begin
               L:=P^.ELEM;
               if ELCOVER[L] = 0 then begin
                  MR:=MR-1;  ELCOVER[L]:=1;
                  Q:=SETLISTS[L].LIST;
                  while Q <> nil do begin
                     K:=Q^.ELEM;
                     if COVER[K] = -1 then DELETESET(K,NR,NSL,COVER);
                     Q:=Q^.NEXT
                  end  { while Q <> nil }
               end;  { if ELCOVER[L] = 0 }
               P:=P^.NEXT
            end;  { while P <> nil }
         end;  { if (ELCOVER[I] = 0) ..., for I }
   end;  { SPRED2 }

   procedure SPRED3R(var BR3R:boolean);
      var H,I,J,K,L:integer;
          B        :boolean;
          temp : integer;
   begin                           { REDUCTION 3R - DOMINATING ROWS }
      BR3R:=false;
      for I:=1 to M-1 do
         if ELCOVER[I] = 0 then begin
            J:=I;
            repeat  { until (J = M) ... }
               J:=J+1;  L:=0;
               if ELCOVER[J] = 0 then begin
                  if NSL[I] <= NSL[J] then begin
                     K:=I;  L:=J
                  end
                  else begin K:=J;  L:=I end;
                  H:=1;  B:=true;
                  while (H <= N) and B do begin
                     if COVER[H] = -1 then B:=A[L,H] >= A[K,H];
                     H:=H+1
                  end;
                  if B then begin            { ROW L CAN BE DELETED }
                     BR3R:=true;  MR:=MR-1;
                     ELCOVER[L]:=1;
                     for H:=1 to N do
                        if COVER[H] = -1 then
                           if A[L,H] = 1 then begin
                              NS[H]:=NS[H]-1;
                              if A[K,H] = 0 then
                              begin
                                 temp := H;
                                 DELETESET(temp,NR,NSL,COVER)
			      end;
                           end  { if A[L,H] = 1 }
                  end { if B }
               end  { if ELCOVER[J] = 0 }
            until  (J = M) or ( B and (L = I))
         end;  { if ELCOVER[I] = 0, for I }
   end;  { SPRED3R }

   procedure SPRED3C;
      var H,I,J,K,L:integer;
          B        :boolean;
   begin                   { REDUCTION 3C - COST DOMINATING COLUMNS }
      for J:=1 to N-1 do
         if COVER[J] = -1 then begin
            I:=J;
            repeat  { until (I = N) ... }
               I:=I+1;  L:=0;
               if COVER[I] = -1 then begin
                  if C[J] <= C[I] then begin K:=J;  L:=I end
                  else begin K:=I;  L:=J end;
                  H:=1;  B:=true;
                  while  (H <= M) and B do begin
                     if ELCOVER[H] = 0 then B:=A[H,K] = A[H,L];
                     H:=H+1
                  end;
                  if B then  DELETESET(L,NR,NSL,COVER)
               end  { if COVER[I] = -1 }
            until (I = N) or (B and (L = J))
         end;  { if COVER[J] = -1, for J }
   end;  { SPRED3C }

   procedure SPRED5(var BR5:boolean);
      { REDUCTION 5 - INFEASIBLE COLUMNS }
      var J:integer;
	  temp : integer;

      function REMOVE(T,NRR:integer;NL:ARRM;COV:ARRN):boolean;
         { REMOVE IS true if SET T CAN BE REMOVED SINCE ITS
           PRESENCE IN THE SOLUTION WOULD CAUSE INFEASIBILITY }
         var I,J:integer;
             B  :boolean;
             P,Q:POINTEL;
             
     begin
         COV[T]:=1;  P:=SETS[T].LIST;
         while (P <> nil) and (NRR > 0) do begin
            I:=P^.ELEM;  Q:=SETLISTS[I].LIST;
            while (Q <> nil) and (NRR > 0) do begin
               J:=Q^.ELEM;
               if COV[J] = -1 then DELETESET(J,NRR,NL,COV);
               Q:=Q^.NEXT
            end;
            P:=P^.NEXT
         end;  { while (P <> nil) ... }
         B:=true;  I:=1;
         while (I <= M) and B do begin
            B:=(ELCOVER[I] = 1) or (NL[I] > 0);
            I:=I+1
         end;
         REMOVE:=not B
      end;  { REMOVE }
   begin                                           { BODY OF SPRED5 }
      BR5:=false;
      for J:=1 to N do
         if COVER[J] = -1 then
            if REMOVE(J,NR,NSL,COVER) then begin
               BR5:=true;
               temp := J;
               DELETESET(temp,NR,NSL,COVER)
            end
   end;  { SPRED5 }

begin                                                   { MAIN BODY }
   COST:=0;
   for I:=1 to M do begin
      ELCOVER[I]:=0;  NSL[I]:=SETLISTS[I].CARD
   end;
   for J:=1 to N do begin
      COVER[J]:=-1;  NS[J]:=SETS[J].CARD
   end;
   MR:=M;  NR:=N;
   NONFEASIBLE:=false;  OPTIMAL:=false;
   if EMPTYLIST then NONFEASIBLE:=true
   else begin
      EMPTYSET;
      SPRED3C;
      repeat  { until not ((BR2 or ... }
         BR2:=false;  BR3R:=false;
         BR5:=false;  CONTINUE:=true;
         SPRED2(BR2);
         if BR2 then CONTINUE:=MN and not EMPTYLIST;
         if CONTINUE then begin
            SPRED3R(BR3R);
            if BR3R then CONTINUE:=MN and not EMPTYLIST;
            if CONTINUE then begin
               SPRED5(BR5);
               if BR5 then CONTINUE:=MN and not EMPTYLIST
            end
         end  { if CONTINUE }
      until not ((BR2 or BR3R or BR5) and CONTINUE);
      if not CONTINUE then
         if MR = 0 then begin
            OPTIMAL:=true;
            for J:=1 to N do
               if COVER[J] = -1 then COVER[J]:=0
         end
         else NONFEASIBLE:=true
   end;  { else: not EMPTYLIST }
end;  { SETPARTRED }


procedure Outfile (MR, NR : integer;
		   NONFEASIBLE, OPTIMAL : boolean;
		   ELCOVER : ARRM;
		   COVER : ARRN;
		   COST : integer);

var count : integer;

begin
  rewrite(SetpartrOutfile);
  writeln (SetpartrOutfile,'The solution is ');
  writeln (SetpartrOutfile,'Nonfeasible = ',NONFEASIBLE);
  writeln (SetpartrOutfile,'OPTIMAL = ',OPTIMAL);
  write (SetpartrOutfile,'ELCOVER[1..M] =    [');
  for count := 1 to M do
  begin
    write (SetpartrOutfile,'  ',ELCOVER[count]:3);
  end;
  writeln(SetpartrOutfile,'     ]');
  writeln(SetpartrOutfile);
  write (SetpartrOutfile,'COVER[1..N] =    [');
  for count := 1 to N do
  begin
    write (SetpartrOutfile,'   ',COVER[count]:3);
  end;
  writeln(SetpartrOutfile,'     ]');
  writeln(SetpartrOutfile);
  writeln (SetpartrOutfile,'COST = ',COST);
end;


begin (* main *)
  Infile (M,N,A,SETS,SETLISTS,C,Nextint);
  SETPARTRED(M,N,MR,NR,A,SETS,SETLISTS,C,NONFEASIBLE,OPTIMAL,ELCOVER,COVER,COST);
  Outfile(MR,NR,NONFEASIBLE,OPTIMAL,ELCOVER,COVER,COST);
end.