
(*                                      Vertex Coloring Problem
                                        Sequential with interchange Algorithm

        INPUT           :  The associated datafile is "InterseqDatafile"
                           1st number (N) represents # of vertices of a graph
                                 to be colored
                           2nd number(M) represents double number of edges of
                                 the graph.
                           3rd number (HI) represents upper bound of the
                                 number of colors used by the algorithm.
                           4th set of numbers (GR) represent  the graph with
                                 its DEGREE, ADJLIST, and COLPOINT.
                            5th set of numbers SEQ[1..N] represents an array
                                 that contains an ordering of vertices of the
                                 graph in which they are to be colored.

        OUTOUT  :  Output is
                           GR[I].COLOR, color of vertex I, for I = 1..N

        Algorithm       :  The sequential with interchange algorithm works
                           similarly to the sequential algorithm except when
                           a new color is introduced.  In this case, it is
                           checked if there exists a subgraph Gpq induced by
                           the vertices of colors p and q such that no
                           connected component of Gpq has more than one color
                           vertex adjcent to the vertex that is to be colored.
                           The time complexity of the INTERSEQCOLORING
                           function is O(LM), wherre L is the number of colors
                           used or O(NM), since L <= M.
                                                                *)


program Seq_Interchange_Alg (input, output, InterseqDatafile,InterseqOutfile);

const    maxvar = 50;
	 maxarc = 100;

type	ARRN = array [1..maxvar] of integer;
	ARR0N = array [0..maxvar] of integer;
	ARRM = array [1.. maxarc] of integer;
  	VERTPOINT = ^VERTLIST;
	ARRNPOINT = array[1..maxvar] of VERTPOINT;
	ARRMPOINT = array [1..maxarc] of VERTPOINT;
	GRAPH = array [1..maxvar] of
		  record
		    DEGREE : integer;
		    COLOR : integer;
		    ADJLIST : VERTPOINT;
		    COLPOINT : array[1..maxvar] of VERTPOINT;
		  end;
   	VERTLIST = record
		      VERTEX : integer;
		      NEXT : VERTPOINT;
		      COLMATE1 : VERTPOINT;
		      COLMATE2 : VERTPOINT;
		      MATE : VERTPOINT;
      		   end;
	CHARFILE = file of char;

var	N : integer;
	M : integer;
	HI : integer;
	GR : GRAPH;
	SEQ : ARRN;
	InterseqDatafile : CHARFILE;
	InterseqOutfile  : CHARFILE;
	Nextint : integer;
        temp : integer;



procedure Infile (var N : integer;
		  var M : integer;
		  var HI : integer;
		  var GR : GRAPH;
		  var SEQ : ARRN;
		  var Nextint : integer);

var count, i  : integer;
    Newelement : VERTPOINT;


begin
  reset (InterseqDatafile);
  readln (InterseqDatafile,Nextint);
  N := Nextint;
  readln (InterseqDatafile,Nextint); 
  M := Nextint;
  HI := N;
  for count := 1 to N do
  begin
    read (InterseqDatafile,Nextint);
    SEQ[count] := Nextint;
  end;
  readln (InterseqDatafile);
  for count := 1 to N do
  begin
    GR[count].ADJLIST := nil;
    read (InterseqDatafile,Nextint);
    GR[count].DEGREE := Nextint;
    while (not eoln(InterseqDatafile)) do
    begin
      new (Newelement);
      read(InterseqDatafile,Nextint);
      Newelement^.VERTEX := Nextint;
      Newelement^.NEXT := GR[count].ADJLIST;
      GR[count].ADJLIST := Newelement;
       for i := 1 to HI do
       begin
         GR[count].COLPOINT[i] := nil;
       end;
    end;
    readln(InterseqDatafile);  
    writeln;
  end;
end;



function INTERSEQCOLORING(
       N,M,HI:integer;
   var GR    :GRAPH;
   var SEQ   :ARRN):integer;

   type PQUEUE=^QUEUE;
        QUEUE = record
                   VERTEX:integer;
                   NEXT  :PQUEUE
                end;
   var H,H1,H2,I,I1,I2,J,J1,K,KK,K1,L,LL:integer;
       EX                               :boolean;
       SGN                              :ARRN;
       HQ,PQ,PQ1,PQ2,PQ3                :PQUEUE;
       P,P1,P2,P3                       :VERTPOINT;

   procedure MATES;
      { THIS procedure MATCHES INTO PAIRS ELEMENTS OF ADJACENCY LISTS
        (VERTLIST ) WHICH CORRESPOND TO THE SAME EDGE OF THE GRAPH }
      var I,J :integer;
          DEGG:ARRN;
          ARR1:ARRM;
          ARR2:ARRMPOINT;
          ARR3:ARRNPOINT;
   begin
      SGN[1]:=1;  I1:=GR[1].DEGREE;
      DEGG[1]:=I1;
      for I:=2 to N do begin
         SGN[I]:=I1+1;  I1:=I1+GR[I].DEGREE;
         DEGG[I]:=I1
      end;  { for I }
      I1:=1;
      for I:=1 to N do begin
         I2:=DEGG[I];
         P:=GR[I].ADJLIST;
         for J:=I1 to I2 do begin
            L:=P^.VERTEX;
            K:=SGN[L];  SGN[L]:=K+1;
            ARR1[K]:=I;  ARR2[K]:=P;
            P:=P^.NEXT
         end;  { for J }
         I1:=I2+1
      end;  { for I }
      I1:=1;
      for I:=1 to N do begin
         I2:=DEGG[I];
         for J:=I1 to I2 do ARR3[ARR1[J]]:=ARR2[J];
         P:=GR[I].ADJLIST;
         for J:=I1 to I2 do begin
            P^.MATE:=ARR3[P^.VERTEX];  P:=P^.NEXT
         end;
         I1:=I2+1
      end  { for I }
   end;  { MATES }

   procedure INSERT(I:integer);
      { THIS procedure INSERTS VERTEX P1^.VERTEX INTO
        LIST OF I-COLOR NEIGHBORS OF VERTEX J }
   begin
      P2:=GR[J].COLPOINT[I];
      GR[J].COLPOINT[I]:=P1;
      P1^.COLMATE1:=P2;  P1^.COLMATE2:=nil;
      if P2 <> nil then P2^.COLMATE2:=P1
   end;  { INSERT }

begin                                                   { MAIN BODY }
   MATES;
   for I:=1 to N do begin                          { INITIALIZATION }
      GR[I].COLOR:=0;
      for J:=1 to HI do GR[I].COLPOINT[J]:=nil
   end;
   K:=1;  K1:=1;
   for I:=1 to N do begin
      I1:=SEQ[I];                       { I1 - VERTEX TO BE COLORED }
      if I > 1 then begin
         I2:=GR[I1].DEGREE+1;
         if I < I2 then I2:=I;
         for L:=1 to I2 do SGN[L]:=0;
         P:=GR[I1].ADJLIST;
         while P <> nil do begin
            L:=GR[P^.VERTEX].COLOR;
            if L <> 0 then SGN[L]:=1;
            P:=P^.NEXT
         end;
         K1:=1;
         while SGN[K1] <> 0 do K1:=K1+1;
                           { K1 IS THE SMALLEST COLOR FOR VERTEX I1 }
         if (K1 > 2) and (K1 > K) and ((I > 4) or ((I=4)
             and (K=2))) then begin        { SEARCH FOR INTERCHANGE }
            EX:=TRUE;  KK:=0;
            while EX and (KK < K) do begin
               KK:=KK+1;  HQ:=nil;
               P:=GR[I1].COLPOINT[KK];
               while P <> nil do begin
                  new(PQ1);
                  if HQ = nil then PQ2:=PQ1;
                  PQ1^.NEXT:=HQ;  HQ:=PQ1;
                  PQ1^.VERTEX:=P^.VERTEX;
                  P:=P^.COLMATE1
               end;  { while P <> nil }
               LL:=KK;
               while EX and (LL < K) do begin
                  PQ3:=PQ2;  PQ2^.NEXT:=nil;
                  for J:=1 to N do SGN[J]:=0;
                  PQ:=HQ;
                  while PQ <> nil do begin
                     SGN[PQ^.VERTEX]:=1;  PQ:=PQ^.NEXT
                  end;
                  LL:=LL+1;  PQ:=HQ;
                  while PQ <> nil do begin
                                 { CONSTRUCTION OF (KK,LL)-SUBGRAPH }
                     H:=PQ^.VERTEX;  H1:=SGN[H];
                     if GR[H].COLOR = KK then H2:=LL else H2:=KK;
                     P:=GR[H].COLPOINT[H2];
                     while P <> nil do begin
                        { SEARCH for H2-COLOR NEIGHBORS OF VERTEX H }
                        I2:=P^.VERTEX;
                        if SGN[I2] = 0 then begin
                           SGN[I2]:=-H1;
                           new(PQ1);
                           PQ1^.NEXT:=nil;  PQ3^.NEXT:=PQ1;
                           PQ3:=PQ1;  PQ1^.VERTEX:=I2
                        end;  { if SGN[I2] = 0 }
                        P:=P^.COLMATE1
                     end;  { while P <> nil }
                     PQ:=PQ^.NEXT
                  end;  { while PQ <> nil }
                  EX:=false;
                  P:=GR[I1].COLPOINT[LL];
                  while (P <> nil) and (not EX) do begin
                     EX:=SGN[P^.VERTEX] <> 0;
                     P:=P^.COLMATE1
                  end
               end  { while EX and (LL < K) - SEARCH FOR COLOR LL }
            end;  { while EX and (KK < K) - SEARCH FOR COLOR KK }
               { if EX=false then FEASIBLE (KK,LL)-SUBGRAPH HAS
                  BEEN FOUND }
            if not EX then begin
               PQ:=HQ;
               while PQ <> nil do begin
                  I2:=PQ^.VERTEX;
                  if GR[I2].COLOR = KK then GR[I2].COLOR:=LL
                  else GR[I2].COLOR:=KK;
                  P:=GR[I2].COLPOINT[LL];
                  GR[I2].COLPOINT[LL]:=GR[I2].COLPOINT[KK];
                  GR[I2].COLPOINT[KK]:=P;
                  PQ:=PQ^.NEXT
               end;  { while PQ <> nil }
               PQ:=HQ;          { INTERCHANGE OF POINTERS TO COLORS }
               while PQ <> nil do begin
                  I2:=PQ^.VERTEX;
                  H:=GR[I2].COLOR;
                  if H = LL then H1:=KK else H1:=LL;
                  P:=GR[I2].ADJLIST;
                  while P <> nil do begin
                     J:=P^.VERTEX;
                     if GR[J].COLOR <> H1 then begin
                        P1:=P^.MATE;  P2:=P1^.COLMATE1;
                        P3:=P1^.COLMATE2;
                        if P3 = nil then GR[J].COLPOINT[H1]:=P2
                        else P3^.COLMATE1:=P2;
                        if P2 <> nil then P2^.COLMATE2:=P3;
                        P1^.COLMATE2:=nil;
                        INSERT(H)
                     end;  { if GR[J].COLOR <> H1 }
                     P:=P^.NEXT
                  end;  { while P <> nil }
                  PQ:=PQ^.NEXT
               end;  { while PQ <> nil }
               K1:=KK
            end  { if not EX }
         end  { if (K1 > 2) ... }
      end;  { if I > 1 }
      GR[I1].COLOR:=K1;               { VERTEX I1 MAY HAVE COLOR K1 }
      if K1 > K then K:=K1;
      P:=GR[I1].ADJLIST;
      while P <> nil do begin
         J:=P^.VERTEX;  P1:=P^.MATE;
         INSERT(K1);
         P:=P^.NEXT
      end  { while P <> nil }
   end;  { for I }
   INTERSEQCOLORING:=K
end;  { INTERSEQCOLORING }




procedure Outfile (GR : GRAPH);


var count : integer;

begin
  rewrite (InterseqOutfile);
  write (InterseqOutfile,'The output obtained using Sequential with interchange ');
  writeln (InterseqOutfile,' Algorithm');
  writeln (InterseqOutfile,'COLORS of VERTICES 1   ..',N:5,  '  are');
  for count := 1 to N do
  begin
    writeln (InterseqOutfile,'	VERTEX[',count:3,' ]',GR[count].COLOR);
  end;
  writeln(InterseqOutfile);

end;



begin (* main *)
  Infile (N,M,HI,GR,SEQ,Nextint);
  temp :=   INTERSEQCOLORING(N,M,HI,GR,SEQ);
  Outfile (GR);
end.
