网络流24题2 太空飞行计划问题

题目描述

W 教授正在为国家航天中心计划一系列的太空飞行。每次太空飞行可进行一系列商业性实验而获取利润。现已确定了一个可供选择的实验集合E={E1，E2，…，Em}，和进行这些实验需要使用的全部仪器的集合I={I1，I2，…In}。实验Ej需要用到的仪器是I的子集RjÍI。配置仪器Ik的费用为ck美元。实验Ej的赞助商已同意为该实验结果支付pj美元。W教授的任务是找出一个有效算法，确定在一次太空飞行中要进行哪些实验并因此而配置哪些仪器才能使太空飞行的净收益最大。这里净收益是指进行实验所获得的全部收入与配置仪器的全部费用的差额。
对于给定的实验和仪器配置情况，编程找出净收益最大的试验计划。

输入输出格式

输入格式：
第1行有2 个正整数m和n。m是实验数，n是仪器数。接下来的m 行，每行是一个实验的有关数据。第一个数赞助商同意支付该实验的费用；接着是该实验需要用到的若干仪器的编号。最后一行的n个数是配置每个仪器的费用。

输出格式：

第1 行是实验编号；第2行是仪器编号；最后一行是净收益。

题解

把每个实验看作二分图X集合中的顶点，每个设备看作二分图Y集合中的顶点，增加源和汇。
统计出所有实验的收入只和maxx，求网络最大流ans，最大收益就是maxx-ans。对应的解就是最小割划分出的源点集合中的点，也就是最后能从源点访问到的顶点的集合。
YMW讲了一个神奇的fill。

代码

var
  n,m,t,maxx,ans:longint;
  d:array [0..101] of longint;
  v:array [0..101] of boolean;
  c:array [0..101,0..101] of longint;
function min(o,p:longint):longint;
begin
  if o<p then exit(o);
  exit(p);
end;

function bfs:boolean;
var
  he,ta,i,x:longint;
  st:array[1..100] of longint;
begin
  he:=0; ta:=1;
  fillchar(d,sizeof(d),0);
  d[0]:=1; st[1]:=0;
  repeat
    inc(he);
    x:=st[he];
    for i:=0 to t do
      if (c[x,i]>0) and (d[i]=0) then
      begin
        d[i]:=d[x]+1;
        inc(ta);
        st[ta]:=i;
        if i=t then exit(true);
      end;
  until he>=ta;
  exit(false);
end;

function dfs(x,maxf:longint):longint;
var
  i,w,used:longint;
begin
  if x=t then exit(maxf);
  used:=0;
  for i:=0 to t do
    if (c[x,i]>0)and(d[i]=d[x]+1) then
    begin
      w:=maxf-used;
      w:=dfs(i,min(w,c[x,i]));
      dec(c[x,i],w);
      inc(c[i,x],w);
      used:=used+w;
      if maxf=used then exit(maxf);
    end;
  dfs:=used;
end;

procedure init;
var
  i,x:longint;
begin
  readln(m,n);
  t:=n+m+1; maxx:=0;
  for i:=1 to m do
    begin
      read(x);
      c[0,i]:=x;
      maxx:=maxx+x;
      while not eoln do
        begin
          read(x);
          c[i,x+m]:=maxlongint div 3;
        end;
      readln;
    end;
  for i:=1 to n do
    begin
      read(x);
      c[m+i,t]:=x;
    end;
end;

procedure fill(x:longint);
var
  i:longint;
begin
  v[x]:=false;
  for i:=0 to t do
    if (c[x,i]>0) and (v[i]) then
      fill(i);
end;

procedure main;
begin
  while bfs do ans:=ans+dfs(0,maxlongint);
  fillchar(v,sizeof(v),true);
  fill(0);
end;

procedure print;
var
  i:longint;
begin
  for i:=1 to m do
    if not v[i] then
      write(i,' ');
  writeln;
  for i:=m+1 to n+m do
    if not v[i] then
      write(i-m,' ');
  writeln;
  write(maxx-ans);
end;

begin
  init;
  main;
  print;
end.