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

Обсуждение задачи 1099. Work Scheduling

Please help me WA2 can you give me some test aganist it?
Послано Edric Mao 10 авг 2010 17:26
program ural;
var n,a,b,z,i:byte;
    r:integer;
    h:array[1..222]of integer;
    l:array[1..49062]of integer;
    t:array[1..49062]of byte;
    p,u:array[1..222]of boolean;
    v:array[1..222]of byte;
procedure search(f,d:byte);
var r:integer;
  begin
    r:=h[d];
    p[d]:=true;
    while r<>0 do
      begin
        if(t[r]<>f)and(p[t[r]]=false)then
          begin
            if v[d]=0 then
              begin
                inc(z);
                v[d]:=t[r];
                v[t[r]]:=d;
              end;
            search(d,t[r]);
          end;
        r:=l[r];
      end;
  end;
function match(d:byte):boolean;
var r:integer;
  begin
    r:=h[d];
    p[d]:=false;
    while r<>0 do
      begin
        if(v[t[r]]>0)and(p[v[t[r]]])and(u[v[t[r]]]=false)and(match(v[t[r]]))then
          begin
            v[t[r]]:=d;
            v[d]:=t[r];
            exit(true);
          end;
        r:=l[r];
      end;
    u[d]:=true;
    exit(false);
  end;
begin
  readln(n);
  while not eof do
    begin
      readln(a,b);
      inc(r);
      l[r]:=h[a];
      h[a]:=r;
      t[r]:=b;
      inc(r);
      l[r]:=h[b];
      h[b]:=r;
      t[r]:=a;
    end;
  for i:=1 to n do
    if p[i]=false then
      search(0,i);
  for i:=1 to n do
    if v[i]=0 then
      begin
        fillchar(p,sizeof(p),true);
        if match(i) then
          inc(z);
      end;
  writeln(z*2);
  for i:=1 to n do
    if v[i]>i then
      writeln(i,' ',v[i]);
end.