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

Обсуждение задачи 1156. Два тура

Why WA??
Послано zhou MX 25 мар 2002 16:49
program Ural_1156;
const
  maxn=100;
var
  map:array[1..maxn,1..maxn] of boolean;
  use:array[1..maxn] of integer;
  mem:array[1..maxn,0..maxn] of integer;
  n,l:integer;

procedure init;
var
  i,a,b,m:integer;
begin
  readln(n,m);
  n:=n+n;
  for i:=1 to m do
  begin
    readln(a,b);
    map[a,b]:=true; map[b,a]:=true;
  end;
end;

procedure search(x,g:integer);
var
  i:integer;
begin
  use[x]:=g;
  if g=1 then
  begin
    inc(mem[l,0]);
    mem[l,mem[l,0]]:=x;
  end;
  for i:=1 to n do
    if map[x,i] then
      if use[i]=0 then
        search(i,-g)
      else
      if use[i]=use[x] then
      begin
        writeln('IMPOSSIBLE');
        halt;
      end;
end;

procedure work;
var
  can:array[0..maxn] of boolean;
  way:array[1..maxn] of integer;
  i,j:integer;
begin
  for i:=1 to n do
    if use[i]=0 then
    begin
      l:=l+1;
      search(i,1);
    end;
  fillchar(can,sizeof(can),0);
  can[0]:=true;
  for i:=1 to l do
    for j:=n downto 0 do
      if can[j] and not can[j+mem[i,0]] then
      begin
        can[j+mem[i,0]]:=true;
        way[j+mem[i,0]]:=i;
      end;
  j:=n div 2;
  if not can[j] then
    writeln('IMPOSSIBLE')
  else begin
    fillchar(use,sizeof(use),0);
    while j<>0 do
    begin
      for i:=1 to mem[way[j],0] do
        use[mem[way[j],i]]:=1;
      j:=j-mem[way[j],0];
    end;
    j:=1;
    while use[j]=0 do
      j:=j+1;
    write(j);
    for i:=j+1 to n do
      if use[i]=1 then
        write(' ',i);
    writeln;
    j:=1;
    while use[j]=1 do
      j:=j+1;
    write(j);
    for i:=j+1 to n do
      if use[i]=0 then
        write(' ',i);
    writeln;
  end;
end;

begin
  init;
  work;
end.