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

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

I don't know whether my algorithm is wrong or my program has error . Please, hepl me.
Послано raxtinhac 27 фев 2002 08:08
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.