На этом шаге рассмотрим программную реализацию задачи.
Для получения цельного представления о решении задачи методом Форда-Фалкерсона приведем полное решение задачи "Новогодняя вечеринка".
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.
Архив с примером можно взять здесь.
На следующем шаге рассмотрим решение еще одной олимпиадной задачи.