I don't know whether my algorithm is wrong or my program has error . Please, hepl me.
Here is my program :
 
const      max  = 100;
 
var        a          :array[1..max,1..max] of byte;
           color      :array[1..max,1..max] of byte;
 
           ke         :array[1..max] of byte;
           g,r        :array[1..max] of byte;
 
           n          :byte;
 
procedure nhap;
var    i,j      :byte;
begin
  read( n);
  for i := 1 to n do
  begin  read( ke[i]);
         for j := 1 to ke[i] do read( a[i,j]);
  end;
end;
 
 
procedure solve;
var     i,j,u,v    :byte;
begin
  fillchar( color, sizeof( color ), 0);
  fillchar(g, sizeof(g), 0);
  fillchar(r, sizeof(r), 0);
 
  repeat
    for i := 1 to n do
      for j := 1 to ke[i] do
        if color[i,j] = 0 then break;
    if color[i,j] > 0 then break;
 
    repeat
      for j := 1 to ke[i] do if color[i,j] = 0 then break;
      if  color[i,j] > 0 then break;
 
      u := a[i,j];
      for v := 1 to ke[u] do if a[u,v] = i then break;
 
      if g[i] > r[i] then
      begin  inc( r[i] ); inc( g[u] );
             color[i,j] := 1;
             color[u,v] := 2;
      end else
      begin  inc( g[i] ); inc( r[u] );
             color[i,j] := 2;
             color[u,v] := 1;
      end;
 
      i := u;
    until false;
 
  until false;
end;
 
 
procedure out;
var     i,j   :byte;
begin
  for i := 1 to n do
  begin
    for j := 1 to ke[i] do
      case color[i,j] of
       1 : write('Y ');
       2 : write('G ');
      end;
    writeln;
  end;
end;
 
 
begin
  nhap;
  solve;
  out;
end.