Описание
Задан ориентированный ациклический граф

Задание
Построить наименьшее количество путей, покрывающих все вершины этого графа и не пересекающихся ни по одной из вершин


Входные данные
В первой строке входного файла записано количество вершин графа N (1≤N≤25). Далее перечислены ребра графа, заданные номерами начальной и конечной вершин

Выходные данные
Выведите в первую строку выходного файла число K – наименьшее количество путей, которыми можно покрыть все вершины графа. Далее выведите сами эти пути (по одному в каждой строке), задавая их номерами вершин в порядке посещения


Например:

PAVEMENT.IN
4
1 2
1 3
2 3
2 4

PAVEMENT.OUT
2
1 2 4
3




Идеи
Наибольшее паросочетание

Комментарии
Предположим, что решение задачи состоит из M путей, а R – суммарное количество ребер в этих путях. Каждый путь из L вершин содержит L-1 ребро. Просуммировав по всем путям, получаем, что N-M=R. Следовательно, задача о покрытии минимальным количеством путей эквивалентна задаче о покрытии такими путями, суммарное количество ребер в которых максимально. А это, в свою очередь, равносильно нахождению наибольшего множества ребер с тем свойством, что в каждую вершину входит и из каждой вершины выходит не более одного ребра данного множества (здесь мы пользуемся ацикличностью графа)

Будем решать последнюю из сформулированных задач. Для этого построим двудольный граф, вершины обеих долей которого соответствуют вершинам исходного графа. При этом вершина a первой доли будет соединена ребром с вершиной b второй доли в том и только том случае, когда в исходном графе существует ориентированное ребро (a,b). Теперь для получения решения необходимо найти максимальное паросочетание в построенном графе
 

Решение

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}

program pavement;
var
  n:integer;
  a:array[1..25,1..25] of boolean;
  FA,FB:array[1..100] of longint;
  UA,UB:array[1..100] of boolean;
 
function MakeB(p:integer):boolean;forward;
procedure ReadInput;
var
  i,j,l:integer;
begin
  assign(input,'pavement.in');
  reset(input);
  read(n);
  fillchar(a,sizeof(a),0);
  while not seekeof(input) do
  begin
    read(j,l);
    a[j,l]:=true;
  end;
  close(input);
end;

procedure WriteOutput;
var
  i,j,k,l,u:integer;
  p:array[1..100] of boolean;
begin
  assign(output,'pavement.out');
  rewrite(output);
  fillchar(p,sizeof(p),0);
  u:=0;
  for i:=1 to n do
  if not p[i] then
  begin
    J:=i;
    repeat
      l:=j;
      for k:=1 to n do
      if FA[k]=j then
      begin
        j:=k;
      end;
    until l=j;
    p[j]:=true;
    while FA[j]<>0 do
    begin
      j:=FA[j];
      p[j]:=true;
    end;
    inc(u);
  end;
  writeln(u);
  fillchar(p,sizeof(p),0);
  for i:=1 to n do
  if not p[i] then
  begin
    j:=i;
    repeat
      l:=j;
      for k:=1 to n do
      if FA[k]=j then
      begin
        j:=k;
      end;
    until l=j;
    write(j,' ');
    p[j]:=true;
    while FA[j]<>0 do
    begin
      j:=FA[j];
      p[j]:=true;
      write(j,' ');
    end;
    writeln;
  end;
 
  close(output);
end;
 
function MakeA(p:integer):boolean;
var
  i:integer;
begin
  if UA[p]=true then
  begin
    MakeA:=false;
    exit;
  end;
  UA[p]:=true;
  for i:=1 to n do
  begin
    if (a[p,i]) and (MakeB(i)) then
    begin
      FA[p]:=i;
      FB[i]:=p;
      MakeA:=true;
      UA[p]:=true;
      exit;
    end;
  end;
  MakeA:=false;
end;

function MakeB(p:integer):boolean;
var
  i:integer;
begin
  if UB[p]=true then
  begin
    MakeB:=false;
    exit;
  end;
  if FB[p]=0 then
  begin
    UB[p]:=true;
    makeB:=true;
    exit;
  end;
  UB[p]:=true;
  makeB:=MakeA(FB[p]);
end;

procedure MakeAll;
var
  i,k:integer;
begin
  k:=0;
  fillchar(FB,sizeof(FB),0);
  fillchar(FA,sizeof(FA),0);
  for i:=1 to n do
  begin
    fillchar(UB,sizeof(UB),0);
    fillchar(UA,sizeof(UA),0);
    if MakeA(i) then
      inc(k);
  end;
end;
 
begin
  ReadInput;
  MakeAll;
  WriteOutput;
end.

 

© Особенности национальных задач по информатике