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

Обсуждение задачи 1211. Круговая порука

please tell me, what's wrong?
Послано Victoriya 3 янв 2017 01:40
var g:array[1..25000,1..25000] of integer; v,i,j,n,f,un,uk,t,k,s,x:longint;
Q:array[1..100000] of integer;
p:array[1..25000] of integer;
begin
assign(input,'input.txt');
assign(output,'output.txt');
reset(input);rewrite(output);
readln(t);
for i:=1 to t do
begin
  readln(n);k:=0;
  fillchar(g,sizeof(g),0);
  for j:=1 to n do begin read(s);
                         if s=0 then begin f:=j; k:=k+1;g[j,j]:=0;end
                                else begin  g[j,s]:=1;g[s,j]:=1;end;
                         if k>1 then break;
                   end;
  readln;
  if k<>1 then begin Writeln('NO');end else
  begin
    for j:=1 to n do p[j]:=-1;
    fillchar(Q,sizeof(Q),0);
    un:=1;
    uk:=2;
    Q[1]:=f;
    p[f]:=0;
    x:=0;
    while un<>uk do
    begin
      v:=Q[un]; un:=un+1;
      for j:=1 to n do
      if (g[v,j]<>0) and (p[j]=-1) then begin
                                        Q[uk]:=j;
                                        uk:=uk+1;
                                        p[j]:=p[v]+1;
                                        end;

    end;
    for j:=1 to n do
      if p[j]=-1 then begin x:=1;break;end;
      if x=0 then writeln('YES') else writeln('NO');
  end;
end;
end.