Описание
В некоторой стране протянута сеть железных дорог. Требуется наладить сообщение между двумя различными городами A и B, пустив наибольшее возможное число поездов от A до B. Из-за конструктивных особенностей поездов, нарушений расписания и прочих объективных причин необходимо, чтобы никакие два поезда не проезжали через один город, за исключением, конечно, городов A и B

Задание
Определите наибольшее число поездов, которое можно пустить между городами A и B


Входные данные
В первой строке входного файла записаны целое число M – количество городов в стране (2≤M≤25) и номера городов A и B (города нумеруются натуральными числами от 1 до M). Далее перечислены все железные дороги страны, каждая из них задается парой номеров городов, которые она соединяет. Все дороги считаются одноколейными и ориентированными, то есть ведущими из первого города пары во второй, но не наоборот.

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


Например:

HELPMRC.IN
5 2 4
2 1
2 3
1 3
3 1
1 4
3 4
3 5

HELPMRC.OUT
2
2 1 4
2 3 4



Идеи
Максимальный поток

Комментарии
Построим ориентированный граф, соответствующий заданной сети железных дорог. Расщепим каждую из его вершин-городов, за исключением A и B, на две. Первая из них будет "пунктом въезда" в город, а вторая – "пунктом выезда". Говоря формально, каждая вершина v графа заменяется на две новых – v1 и v2, причем все ребра, входившие ранее в v, теперь будут входить в v1 , а все ребра, исходившие ранее из v, будут исходить из v2, кроме того, добавляется ребро (v1,v2). В результате этой операции мы свели условие непересечения маршрутов поездов по вершинам к условию их непересечения по ребрам. Теперь выбираем города A и B в качестве источника и стока, а пропускные способности всех ребер полагаем равными единице. В получившейся сети ищем максимальный поток, его величина и есть искомое число K (докажите это и придумайте, как по максимальному потоку построить маршруты поездов)


Замечание
Идея задачи взята из книги [Кормен 99]. Там же, в главе 27, можно найти очень хорошее изложение алгоритмов поиска максимального потока в сети
 

Решение

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

interface

const
  NMax = 100;
type
  tFlow = array[1..NMax, 1..NMax] of integer;
  tC = array[1..NMax, 1..NMax] of integer;
 
procedure FindFlow(var Flow : tFlow; const C : Tc; const s, t, N : integer);
implementation
type
  tHigh = array[1..NMax] of integer;
var
  h, e : THigh;
  st : array[1..NMax] of integer;
  inSt : array[1..NMax] of boolean;
  hSt : integer;
 
procedure Error(const s : string);
begin
  writeln('Ошибка '+s);
  halt;
end;
 
function Minimum(a, b : integer) : integer;
begin
  minimum := a;
  if b < a then
    minimum := b;
end;
 
procedure Push(k : integer);
begin
  inc(hSt);
  st[hSt] := k;
  inSt[k] := true;
end;
 
procedure FindFlow(var Flow : tFlow; const C : TC; const s, t, N : integer);
var
  i, cur, min : integer;
  fl : boolean;
begin
  fillChar(h, sizeOF(h), 0);
  h[s] := N;
  fillChar(flow, sizeOf(flow), 0);
  fillChar(e, sizeOf(e), 0);
  fillChar(inSt, sizeOf(inSt), false);
  inSt[s] := true; inSt[t] := true;
  hSt := 0;
 
  for i := 1 to N do
    if c[s, i] > 0 then begin
      flow[s, i] := c[s, i];
      inc(e[i], c[s, i]);
 
      if not inSt[i] then
        Push(i);
    end;
 
  while hSt <> 0 do begin
    cur := st[hSt]; dec(hSt); inSt[cur] := false;
 
    min := 3*N+1;
    fl := true;
    for i := 1 to n do
      if c[cur, i]- flow[cur, i] > 0 then
        if h[cur] = h[i]+1 then begin
          fl := false;
          min := minimum(e[cur], c[cur, i]-flow[cur, i]);
          dec(e[cur], min);
          inc(e[i], min);
          inc(flow[cur, i], min);
 
          if not inSt[i] and (e[i] > 0) then
            Push(i);
        end
        else if h[i] < min then
          min := h[i];
 
    for i := 1 to n do
      if flow[i, cur] > 0 then
        if h[cur] = h[i]+1 then begin
          fl := false;
          min := minimum(e[cur], flow[i, cur]);
          dec(e[cur], min);
          inc(e[i], min);
          dec(flow[i, cur], min);
 
          if not inSt[i] and (e[i] > 0) then
            push(i);
        end
        else if h[i] < min then
          min := h[i];
 
    if fl then
      h[cur] := min + 1;
 
    if e[cur] > 0 then
      Push(cur);
  end;
 
  for i := 1 to n do
    if (i<>s) and (i<>t) and (e[i] > 0) then
      Error('Не поток, сливаем');
  for cur := 1 to n do
    for i := 1 to n do
      if flow[cur, i] < 0 then
        Error('Не поток, отрицателен');
end;
 
end.
 

 

{$A+,B-,D+,E+,F-,G-,I-,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
{$M 65520,0,655360}
 
uses helpmrc_u;
const mMax = 25;
var
  m, A, B, AtoB : integer;
  Net : array[1..Nmax, 1..NMax] of boolean;
  c : tC;
  flow : tFlow;
 
procedure Init;
var
  i, j : integer;
begin
  assign(input, 'helpmrc.in');
  reSet(input);
  fillChar(Net, sizeOf(Net), false);
  AtoB := 0;
 
  read(m, A, B);
  while not seekEof do begin
    read(i, j);
    if i<>j then begin
      Net[i,j] := true;
      if (i = A) and (j = B) then
        inc(AtoB);
    end;
  end;
end;
 
procedure makeNet;
var
  i, j, K : integer;
begin
  fillChar(c, sizeOf(c), 0);
  for i := 1 to M do
    c[2*i-1, 2*i] := 1;
 
  for i := 1 to m do
    for j := 1 to m do
      if net[i, j] then
        c[2*i, 2*j-1] := 1;
 
  findFlow(flow, c, 2*A, 2*B-1, 2*M);
end;
 
procedure Print;
var
  i, j, k : integer;
begin
  assign(output, 'helpmrc.out');
  reWrite(outPut);
 
  k := 0;
  for i := 1 to m do
    if flow[2*A, 2*i-1] = 1 then
      inc(k);
 
  if AtoB > 0 then
    inc(k, AtoB-1);
 
  writeLn(k);
 
  for i := 1 to m do
    if flow[2*A, 2*i-1] = 1 then begin
      write(A,' ');
 
      k := i;
      while k <> B do begin
        write(k,' ');
 
        j := 1;
        while flow[2*k, 2*j-1] = 0 do
          inc(j);
 
        k := j;
      end;
 
      writeLn(B, ' ');
    end;
 
  for i := 1 to AtoB-1 do
    writeln(A,' ',B);
end;
 
begin
  init;
  makeNet;
  Print;
end.

 

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