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

Обсуждение задачи 1109. Конференция

Are the tests correct? (+)
Послано Mephistos 17 сен 2003 19:58
Seems like there're some bugs in the tests. The following code gives
Time-limit exceeded on the input checking code.

const
  MaxN = 1100;

var
  N, M, K: Integer;
  G:array[1..MaxN, 1..MaxN] of Boolean;
  Cnt:array [1..2, 1..MaxN] of LongInt;

procedure Inp;
var
  I:Integer;
  A, B:Integer;
begin
  Read(M, N, K);
  FillChar(G, sizeof(G), 0);
  fillChar(Cnt, Sizeof(Cnt), 0);

  for I:=1 to K do
    begin
      Read(A, B);
      G[A, B]:=True;
      Inc(Cnt[1, A]);
      Inc(Cnt[2, B]);
    end;

  for I:=1 to M do
    if (Cnt[1, I]=0) then begin repeat until false; end; <--HERE


  for I:=1 to N do
    if (Cnt[2, I]=0) then begin repeat until false; end; <--OR HERE
end;

var
  C:array[1..2, 1..MaxN] of Integer;
  Count:Integer;

function FindPath(F:Integer):Boolean;
var
  Q:array[1..MaxN] of Integer;
  W:array[1..MaxN] of boolean;
  Fr:array[1..MaxN] of Integer;
  T, H:Integer;
  Cur:Integer;
  I:Integer;

procedure Backtrace(Fin:Integer);
var
  I, Ni:Integer;
begin
  I:=Fin;
  repeat
     Ni:=C[1, Fr[I]];
     C[1, Fr[I]]:=I;
     C[2, I]:=Fr[I];
     I:=Ni;
  until I=0;
end;

begin
  FindPath:=False;
  FillChar(W, Sizeof(W), 0);
  H:=1;
  T:=0;
  Q[H]:=F;

  repeat
    Inc(T);
    Cur:=Q[T];

    for I:=1 to N do
      if (G[Cur, I]) and (not W[I]) and (C[1, Cur]<>I) then
        if (C[2, I]=0) then
          begin
            Fr[I]:=Cur;
            Count:=Count+1;
            Backtrace(I);
            FindPath:=True;
            Exit;
          end
        else
          begin
            W[I]:=True;
            Fr[I]:=Cur;
            Inc(H);
            Q[H]:=C[2, I];
          end;
  until T>=H;
end;

procedure FindMinimal;
var
  Found:Boolean;
  I:Integer;
begin
  FillChar(C, sizeof(C), 0);

  repeat
    Found:=False;
    for I:=1 to M do
      if (C[1, I] = 0) then
        if (FindPath(I)) then
          begin
            Found:=True;
            Break;
          end;
  until not Found;
end;

procedure Run;
var
  I:Integer;
begin
  Count:=0;
  FindMinimal;

  for I:=1 to M do
    if (C[1, I]=0) and (Cnt[1, I] <> 0) then Inc(Count);

  for I:=1 to N do
    if (C[2, I]=0) and (Cnt[2, I] <> 0) then Inc(Count);

  WriteLn(CounT);
end;

procedure Out;
begin
end;

begin
  Inp;
  Run;
  Out;
end.