ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1129. Door Painting

I try many test but I still got WA, please help
Posted by raxtinhac 14 May 2002 21:46
This is my programme :

const     max   = 100;

var       ke,color    :array[1..max,0..max] of byte;
          mau         :array[1..max,1..2] of byte;

          n           :integer;

procedure input;
var     i,j             :byte;
begin
  read( n);
  for i := 1 to n do
  begin
    read( ke[i,0]);
    for j := 1 to ke[i,0] do
      read( ke[i,j]);
    read;
  end;
end;


procedure chonmau(i:byte; var t :byte);
begin
  if mau[i,1] >= mau[i,2]
  then  t := 2
  else  t := 1;
end;


procedure tomau(i,j,t :byte);
var    u,v            :byte;
begin
 repeat
  color[i,j] := t;
  inc( mau[i,t] );

  u := ke[i,j];
  for v := 1 to ke[u,0] do
    if ke[u,v] = i then break;

  color[u,v] := 3-t;
  inc( mau[u,3-t] );

  for v := 1 to ke[u,0] do
    if color[u,v] = 0 then break;

  i := u; j := v;
 until color[i,j] <> 0;
end;


procedure solve;
var    i,j,t      :byte;
begin
  fillchar( color, sizeof(color), 0);
  fillchar( mau, sizeof(mau), 0);

  for i := 1 to n do
    for j := 1 to ke[i,0] do
      if color[i,j] = 0 then
      begin
        chonmau(i,t);
        tomau(i,j,t);
      end;
end;


procedure out;
var  i,j  :byte;
begin
  for i := 1 to n do
  begin
    for j := 1 to ke[i,0] do
     case color[i,j] of
     1 : write('G ');
     2 : write('Y ');
     end;
    writeln;
  end;
end;


begin
  input;
  solve;
  out;
end.