ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1129. Покраска дверей

I try many test but I still got WA, please help
Послано raxtinhac 14 май 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.