太空飞行计划问题

题目描述

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行是仪器编号；最后一行是净收益。

输入输出样例

输入样例#1：
2 3
10 1 2
25 2 3
5 6 7
输出样例#1：
1 2
1 2 3
17

分析：最大权闭合图问题，可以转化成最小割问题，进而用最大流解决。
【建模方法】
把每个实验看作二分图X集合中的顶点，每个设备看作二分图Y集合中的顶点，增加源S和汇T。
1、从S向每个Xi连接一条容量为该点收入的有向边。
2、从Yi向T连接一条容量为该点支出的有向边。
3、如果一个实验i需要设备j，连接一条从Xi到Yj容量为无穷大的有向边。

统计出所有实验的收入只和Total，求网络最大流Maxflow，最大收益就是Total-Maxflow。对应的解就是最小割划分出的S集合中的点，也就是最后能从S访问到的顶点的集合。

写完这题后我学到了如何解决最大权闭合子图的问题，还有一种新的求最小割的方法：从源点开始用一次fill，所有源点能到达的点即为最小割的S集合。

代码：

var
  n,m,x,tot,ans,i,s,t:longint;
  v:array[0..100] of boolean;
  d:array[0..100] of longint;
  c:array[0..100,0..100] of longint;

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

function min(x,y:longint):longint;
begin
  if x<y then exit(x)
         else exit(y);
end;

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

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

begin
  readln(m,n);
  s:=0; t:=n+m+1;
  for i:=1 to m do
  begin
    read(x);
    c[s,i]:=x;
    tot:=tot+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;

  while bfs do
  begin

   ans:=ans+dfs(s,maxlongint div 3);
  end;
  fillchar(v,sizeof(v),true);
  fill(s);
  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;
  writeln(tot-ans);

end.