Шаг 70.
Алгоритмы.
Реализация задачи поиска максимального потока

    На этом шаге рассмотрим программную реализацию задачи.

    Для получения цельного представления о решении задачи методом Форда-Фалкерсона приведем полное решение задачи "Новогодняя вечеринка".

Program newyearparty;
const 
	MaxN = 200; 
	MaxD = 100; 
	MaxV = MaxN+MaxD+2; 

var
	input, output : TextFILE;
	N : 3..MaxN; {Количество мам}
	K : 1..5; {Количество блюд на одну маму} 
	D : 5..MaxD; {Количество видов пищи} 
	Lim : Array[1..MaxD] of integer; {Предел количества блюд на вид пищи} 
	Z : integer; {Количество типов блюд, которое мама может приготовить} 
	FoodID : integer; {Идентификатор блюда, которое мама может приготовить} 
	Max  : integer; {Максимальное количество блюд, которое может 
		быть принесено на вечеринку}
	a : array [0..MaxV, 1..MaxV] of integer; {Граф исток-мамы-блюда-сток} 
	Ka : array [0..MaxV] of integer;  {Количество ребер из вершины} 
	c, f, cf : array [0..MaxV, 0..MaxV] of byte; {Beca вершин в графе A}
	i, j, Finish : integer;
	ia : array [0..MaxV, 1..MaxV] of  integer; {Список входящих вершин}
	Kia : array [0.. MaxV] of integer; {Количество входящих ребер} 

Procedure Init;
var i, j : integer;
begin 
  for i := 0 to Finish do 
    for j := 0 to Finish do f[i,j] := 0; 
  for i := 0 to Finish do 
    for j := 0 to Finish do cf[i,j] := c[i,j]; 
  {построение списков входящих дуг} 
  for i := 0 to Finish do kia[i] := 0; 
  for i := 0 to Finish do {по всем вершинам} 
    for j := 1 to Finish do ia[i,j] := -1; {no всем исходящим дугам} 
  for i := 0 to Finish do {по всем вершинам} 
    for j := 1 to ka[i] do {no всем исходящим дугам} 
    begin 
      inc(kia[a[i,j]]); {инкремент количества дуг, входящих в a[i,j]} 
      ia[a[i,j],kia[a[i,j]]] := i; {запоминаем вершину i, как входящую в a[i,j]} 
    end;
end;

Procedure InputData; 
var 
	i, j : integer;
begin 
  assign(input, 'party.in'); 
  reset(input); 
  read(input, N, K, D); {Прочитали N-мам, D-блюд, К-предел блюд} 
  Finish := N + D + 1;
  for i := 0 to Finish do {Инициализируем пустой граф} 
    begin {исток-мамы-блюда-сток} 
      for j := 1 to Finish do a[i,j] := 0; 
      ka[i] := 0; 
    end; 
    {Добавляем вершину-исток}
  ka[0] := N;  {Из истока - N дуг - к каждой маме}  
  for i := 1 to N do 
  begin 
    a[0, i] := i; {Номер вершины, соединенной с истоком} 
    c[0, i] := K; {ee вес - максимальное количество блюд для мамы} 
  end;
  for i := 1 to D do read(input, Lim[i]); {Пределы блюд каждого типа} 
 {Добавляем вершину-сток} 
  for i := N + 1 to N + D do 
  begin 
    ka[i] := 1; 
    a[i, 1] := Finish; {одна дуга от каждого блюда к стоку} 
    c[i, Finish] := Lim[i - N]; {ee вес - предел числа блюд данного типа} 
  end;
  {Добавляем вершины от мам к блюдам}
  for i := 1 to N do {Для каждой мамы}
  begin 
    read(input, Z); 
    ka[i] := Z; {Количество блюд, которые она готовит} 
    for j := 1 to Z do {Для каждого такого блюда}
    begin 
      read(input, FoodID); {Читаем его номер}
      a[i, j] := N + FoodID; {Добавляем дугу от мамы к блюду} 
      c[i, a[i, j]] := 1; {Bec такой дуги - 1} 
    end; 
  end; 
  close(input); 
end; 

Procedure OutputData;
var 
	i : integer; 
begin 
  assign(output, 'party.out'); 
  rewrite(output); 
  {Поток, входящий в вершину-сток, с номером Finish}
  Max := 0; 
  for i := N + 1 to N + D do Max := Max + f[i, Finish]; 
  writeln(output, Max); 
  close(output); 
end;

Procedure MaxFlow;
var 
	KR, Cmin, u, v : integer; 
	path : array [0..MaxV] of integer; 
	i : integer;

Function ExistPath(var KR, Cmin : integer) : boolean; { Поиск в ширину } 
Const  
  WHITE = 1; 
  GRAY = 2; 
var 
  color, back : array [0..MaxV] of integer; 
  Q : array [0..MaxV] of integer; 
  EndQ, BegQ : integer; 
  Find : Boolean; 
  i : integer;
  
Procedure Put(x : integer); 
begin 
  inc(EndQ);
  Q[EndQ] := x;  
end;
 
Procedure Get(var x : integer); 
begin 
  x := Q[BegQ]; 
  inc(BegQ); 
end; 

begin 
  for  i := 0 to  Finish do  color[i] := WHITE;  {Bce вершины свободны} 
  for  i := 0 to  Finish do  Q[i] := -1; {Bce вершины свободны} 
  color[0] := GRAY; {Начальная вершина - обработана} 
  back[0]  := - 1; 
  BegQ := 1; {Начало очереди} 
  EndQ := 0; {Очередь пуста} 
  KR := 0;  {Количество дуг в пути = 0} 
  Put(0); {Поместить в очередь начальную вершину} 
  Find := false; 
  while  (BegQ <= EndQ) and not  Find do  {Пока очередь не пуста и путь не найден} 
  begin  
    Get(i); {Взять вершину i из очереди} 
    j:= 1;   {номер дуги из вершины i} 
    while  (a[i, j] > 0) and not  Find do  {пока дуги не кончились}
    begin  
	{если вершина a[i,j] свободна} 
      if  (color[a[i, j]] = WHITE) and  (cf[i, a[i, j]] > 0) then 
      begin 
        Put(a[i, j]); {поставить ее в очередь} 
        back[a[i, j]] := i; {в вершину a[i,j] - из вершины i} 
        color[a[i, j]] := GRAY; {пометить вершину a[i,j]как использованную}
        Find := a[i, j] = Finish; 
      end ; 
      inc(j); {взять следующую дугу} 
    end; 
    {Проход по отрицательным ребрам}
    j := 1; {номер дуги из вершины i}
    while  (ia[i, j] >= 0) and not  Find do   {пока дуги не кончились} 
    begin  
      if  (color[ia[i, j]] = WHITE) and  (cf[i, ia[i, j]] > 0) then  
      {если вершина a[i,j] свободна}
      begin 
        Put(ia[i, j]); {поставить ее в очередь} 
        back[ia[i, j]] := i; {в вершину a[i,j] - из вершины i} 
        color[ia[i, j]] := GRAY; {пометить вершину a[i,j] }
                                {как использованную}
        Find := ia[i, j] = Finish;
      end;
      inc(j); {взять следуюшую дугу} 
    end; 
  end; 
  {Восстановление пути из очереди} 
  KR := 0; 
  i := Finish; {Начинаем с конца} 
  Cmin := maxint; 
  while (i <> 0) do {Пока не начало} 
  begin 
    Inc(KR); {Увеличиваем к-во дуг в пути} 
    path[KR] := i; {Заносим номер предыдущей вершины} 
    i := back[i]; {Меняем текущую вершину} 
    if  Cmin > cf[i, path[KR]] then  
	    Cmin := cf[i, path[KR]]; {Минимальный добавляемый поток} 
  end;
  path[KR + 1] := 0;
  ExistPath := Find;
end;

begin
  Init; {Инициализация нулевого потока} 
  While ExistPath(KR,Cmin) do {CMin - минимальный из cf(u,v)=c(u,v)-f(u,v)} 
    for i:=KR downto 1 do {Для каждой дуги увеличивающего пути} 
    begin 
      u:= path[i+1]; {U->V - дуга с номером i в пути} 
      v:= path[i]; 
      f[u,v]:=f[u,v]+Cmin; {Увеличиваем поток на минимальную величину} 
      f[v,u]:=-f[u,v]; {f(v,u)=-f(u,v)} 
      cf[u,v]:=c[u,v]-f[u,v]; {Перевычисляем остаточную пропускную способность} 
      cf[v,u]:=c[v,u]-f[v,u]; {на дугах увеличивающего пути} 
    end; 
end;

begin
  InputData;
  MaxFlow;
  OutputData;
end.

    Архив с примером можно взять здесь.

    На следующем шаге рассмотрим решение еще одной олимпиадной задачи.




Предыдущий шаг Содержание Следующий шаг