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

Общий форум

1080 WA give me some test data?
Послано ^oo^ 12 ноя 2002 20:17
var
  d:array[1..99,0..98] of integer;
  n,nw,i,j,cs,t,w:integer;
  q:array[1..99] of integer;
  c:array[1..99] of 0..2;

begin

  read(n);
  for i:=1 to n do
  begin
    j:=0;
    repeat
      inc(j);
      read(d[i,j]);
    until d[i,j]=0;
    d[i,0]:=j-1;
  end;
  fillchar(c,sizeof(c),2);

  for i:=1 to n do
  if c[i]=2 then
  begin
    q[1]:=i; c[i]:=0;
    cs:=0; t:=1; w:=2; nw:=w;

    while t<w do
    begin
      cs:=(c[q[t]]+1) mod 2;
      for i:=1 to d[q[t],0] do
        begin
          if c[d[q[t],i]]=2 then
          begin
            q[nw]:=d[q[t],i];
        c[d[q[t],i]]:=cs; inc(nw);
          end
          else begin writeln('-1'); halt; end;
        end;
      inc(t);
      w:=nw;
    end;
  end;
  for i:=1 to n do write(c[i]);
  writeln;

end.