(*			Vertex Coloring Problem
 			Backtracking Algorithm Algorithm

	INPUT	:  The assoicated datafile is "BacktracDatafile"
		   1st number (N) represents # of vertices of a graph
			to be colored
		   2nd number (LOWERBOUND) represents lower bound
			to the chromatic number of the graph.
		   3rd set of numbers (SEQ[1..N]) represents array
			that contains ordering of vertices of the
			graph in which they are to be colored.
		   4th set of numbers (GR[1..N]) represents the graph.
			It specifies the DEGREE and ADJLIST of a given
			vertex in the graph.

	OUTPUT	:  Outputs are
		   1. COUNT,  number of forward steps performed by the
			algorithm to find the optimal coloring.
		   2. GR[I].COLOR,  color of vertex I for I := 1 to N
			in the optimal coloring of the graph.

	ALGORITHM :  The algorithm is based on backtracking seqential
		     algorithm with teh simple look-ahead procedure.
		     There are basically two procedures in the algorithm,
		     FORWARD steps combined with look-ahead and 
	  	     BACKWARD steps.  For a further detail of each procedure,
		     see pages 430-433 of "Discrete Optimization Algorithms"
		     by Syslo, Deo, and Kowalk.

	Note	:    An ordering  of vertices that are to be colored may
		     have a great influence on efficiency of the algorithm
		     for particular graphs. For instance, while coloring
		     Mycielsk's graph M5, the number of forward steps for the
		     largest-first ordering was seven times smaller than that
		     for the smallest-last ordering.
								*)

	
program backtracking (input,output,BacktracDatafile);


const maxvar = 50;

type	CHARFILE = file of char;
	ARRN	= array[1..maxvar] of integer;
        VERTPOINT = ^VERTLIST;
        GRAPH	= array[1..maxvar] of
     		    record
			DEGREE : integer;
			COLBOUND : integer;
			COLOR : integer;
                        CURCOL : integer;
			LK : integer;
			NUMCOL : integer;
			COLLIST : array[1..maxvar] of integer;
			ADJLIST : VERTPOINT
                    end;        
	VERTLIST = record
		    VERTEX : integer;
		    NEXT : VERTPOINT
                  end;


var	N : integer;
	LOWERBOUND : integer;
	COUNT : integer;
	GR : GRAPH;
	SEQ : ARRN;
        BacktracDatafile : CHARFILE;
  	Nextint : integer;
        tmpINT : integer;



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

var loop : integer;
    Newelement : VERTPOINT;


begin
  reset (BacktracDatafile);
  readln (BacktracDatafile, Nextint);
  N := Nextint;
  writeln('INPUTS ARE');
  writeln ('N is ',N);
  readln (BacktracDatafile, Nextint);
  LOWERBOUND := Nextint;
  writeln ('LOWERBOUND is',LOWERBOUND);
  for loop := 1 to N do
  begin
    read (BacktracDatafile, Nextint);
    SEQ[loop] := Nextint;
    write (SEQ[loop]);
  end;
  writeln;
  readln (BacktracDatafile);
  for loop := 1 to N do
  begin
    GR[loop].ADJLIST := nil;
    read (BacktracDatafile,Nextint);
    GR[loop].DEGREE := Nextint;
    write (GR[loop].DEGREE);
    while (not eoln(BacktracDatafile)) do
    begin
      new (Newelement);
      read (BacktracDatafile,Nextint);
      Newelement^.VERTEX := Nextint;
      Newelement^.NEXT := GR[loop].ADJLIST;
      GR[loop].ADJLIST := Newelement;
      write (GR[loop].ADJLIST^.VERTEX);
    end;
    writeln;
    readln (BacktracDatafile);
  end;
  
end;
      
(*************************************************************)


function BACKTRACKSEQCOLORING( N : integer;
			       LOWERBOUND : integer;
			       var COUNT : integer;
			       var GR : GRAPH;
			       var SEQ : ARRN) : integer;


var COL, H, I,J,K,K1,L,Q : integer;
    INCREASE : boolean;
    P : VERTPOINT;
    SEQ1 : ARRN;



procedure BACKSTEP;
(*   Backtracking from vertex K1 to its predecessor in SEQ *)

begin
  K := K-1;
  K1 := SEQ[K];
  COL := GR[K1].CURCOL;
  L := GR[K1].LK;
  P := GR[K1].ADJLIST;
  while P <> nil do
  begin
    H := P^.VERTEX;
    if SEQ[H] > K then
      with GR[H] do
      begin
        if COLLIST[COL] = K then
        begin
          COLLIST[COL] := N;
          NUMCOL := NUMCOL +1;
        end
     end;
    P := P^.NEXT
  end;   
  COL := COL + 1;
  INCREASE := false;
end; (* BACKSTEP *)

  

  begin (* main body *)
    for I := 1 to N do
       SEQ1[SEQ[I]] := I;
    for I := 1 to N do
       with GR[SEQ[I]] do
       begin
         NUMCOL := DEGREE + 1;
         if NUMCOL > I then NUMCOL := I;
         COLBOUND := NUMCOL;
         for J := 1 to NUMCOL do
           COLLIST[J] := N;
         for J := NUMCOL + 1 to N do
           COLLIST[J] := 0
       end;
    COUNT := 0;
    K := 1;
    K1 := SEQ[1];  (* K1 0VERTEX to be colored *)
    COL := 1;
    Q := N;
    L := 0;
    INCREASE := true;
    
    repeat
       if INCREASE then  (* forward step *)
       begin
         I := GR[K1].COLBOUND;
         if I > L +1 then I := L+1;
         while (GR[K1].COLLIST[COL] < K) and (COL <= I) do
            COL := COL + 1;
       (*  COL is the color for vertex K1 *)
         if COL = I + 1 then INCREASE := false
         else
         begin
           if K =N then
           begin
           (* new complete coloring has been found *)
             COUNT := COUNT + 1;
             GR[K1].CURCOL := COL;
             for I := 1 to N do
               with GR[I] do COLOR := CURCOL;
             if COL > L then L := L + 1;
             Q := L ;
             if Q > LOWERBOUND then
             begin
             (* backtracking to first vertex of color Q *)
               I := 1;
               while GR[SEQ[I]].COLOR <> Q do I := I + 1;
               for J := N downto 1 do
                 BACKSTEP;
               L := Q-1;
               for I := 1 to N do
                 with GR[I] do
                   if COLBOUND > L then
                   begin
                     for J := L +1 to COLBOUND do
                       if COLLIST[J] = N then
                         NUMCOL := NUMCOL - 1;
                     COLBOUND := L
                   end
             end
           end (* K =N *)
           else (* K < N *)
           begin
             P := GR[K1].ADJLIST;
             while (P <> nil) and INCREASE do
             begin
               H := P^.VERTEX;
               if SEQ1[H] > K then
                 with GR[H] do
                   INCREASE := not ((NUMCOL = 1) and (COLLIST[COL] >= K));
               P := P^.NEXT
             end;
             if INCREASE then
             begin
               COUNT := COUNT + 1;
               GR[K1].CURCOL := COL;
               GR[K1].LK := L;
               if COL > L then L := L+1;
               P := GR[K1].ADJLIST;
               while P <> nil do
               begin
                 H := P^.VERTEX;
                 if SEQ1[H] > K then
                   with GR[H] do
                     if COLLIST[COL] >= K then
                     begin
                       COLLIST[COL] := K;
                       NUMCOL := NUMCOL -1
                     end;
                 P := P^.NEXT
               end;
               K := K+1;
               K1 := SEQ[K];
               COL := 1
            end (* increase *)
            else COL := COL +1
          end (* K < N *)
         end  
        end  (* increase = true *)
         else   
       begin  (* backward step *)
          INCREASE := true;
          if (COL > GR[K1].COLBOUND) or (COL > L+1) then
            BACKSTEP
         end; (* INCREASE = false *)
(*       end;  *)
     until (K=1) or (Q = LOWERBOUND );
     BACKTRACKSEQCOLORING := Q

end;  (* BACKTRACKSEQCOLORING *)

(*****************************************************************)


procedure Outfile (GR : GRAPH;
		   COUNT : integer);


var loop : integer;


begin
  writeln;
  writeln ('OUTPUTS ARE');
  write (' number of forward steps performed by the algorithm is ');
  writeln (COUNT);
  writeln ('color of vertex I in the optimal graph coloring is');
  writeln;
  for loop := 1 to N do
  begin
    writeln ('GR[',loop:2,'] == ',GR[loop].COLOR);
  end;
end;


(********************************************************************)


begin (* main *)
  Infile(N,LOWERBOUND,GR,SEQ,Nextint);
  tmpINT := BACKTRACKSEQCOLORING(N,LOWERBOUND,COUNT,GR,SEQ);
  Outfile(GR,COUNT);
end.