圆桌问题 2011-12-29

算法实现题8-5 圆桌问题（习题 8-15）
´问题描述：
假设有来自 n 个不同单位的代表参加一次国际会议。每个单位的代表数分别为
n i ri
, , 2 , 1 ,  = 。会议餐厅共有 m张餐桌，每张餐桌可容纳 ) , , 2 , 1 ( m i ci
 = 个代表就餐。
为了使代表们充分交流， 希望从同一个单位来的代表不在同一个餐桌就餐。 试设计一个算法，
给出满足要求的代表就餐方案。
´编程任务：
对于给定的代表数和餐桌数以及餐桌容量，编程计算满足要求的代表就餐方案。
´数据输入：
由文件input.txt提供输入数据。文件第1行有 2 个正整数m和 n，m表示单位数，n表
示餐桌数，1<=m<=150, 1<=n<=270。文件第 2 行有m个正整数，分别表示每个单位的代表
数。文件第3行有n个正整数，分别表示每个餐桌的容量。
´结果输出:
程序运行结束时，将代表就餐方案输出到文件 output.txt 中。如果问题有解，在文件第
1行输出1，否则输出0。接下来的m行给出每个单位代表的就餐桌号。如果有多个满足要
求的方案，只要输出1个方案。
输入文件示例  输出文件示例 
输入文件示例
input.txt
4 5
4 5 3 5
3 5 2 6 4 

输出文件示例
output.txt
1
1 2 4 5
1 2 3 4 5
2 4 5
1 2 3 4 5 

 

————————————————————

 1 Program Stone;
 2 var flow,n,m,s,t,tot:longint;
 3     map:array[0..500,0..500]of longint;
 4     dis,cur,vh:array[0..1000]of longint;
 5  procedure init;
 6  var i,j,k:longint;
 7   begin
 8     readln(m,n);
 9     s:=0;t:=m+n+1;
10     for i:=1 to m do
11      begin
12        read(j);
13        map[s,i]:=j;
14        inc(tot,j);
15      end;
16     for i:=1 to n do
17      begin
18        read(j);
19        map[i+m,t]:=j;
20      end;
21     for i:=1 to m do
22      for j:=1 to n do
23        map[i,j+m]:=1;
24   end;
25  function min(x,y:longint):longint;
26   begin
27    if x<y then min:=x else min:=y;
28   end;
29  function aug(x,nf:longint):longint;
30  var i,j,d,l,minh,ins:longint;
31   begin
32     if x=t then exit(nf);
33     l:=nf;
34     for i:=cur[x] to t do
35      if (map[x,i]>0)and(dis[i]+1=dis[x]) then
36      begin
37          cur[x]:=i;
38          d:=aug(i,min(l,map[x,i]));
39          dec(map[x,i],d);
40          inc(map[i,x],d);
41          dec(l,d);
42          if (dis[s]=t+1)or(l=0) then exit(nf-l);
43      end;
44     if l=nf then
45      begin
46        minh:=t+1;
47        for i:=s to t do
48          if (map[x,i]>0)and(minh>dis[i]) then begin minh:=dis[i];ins:=i;end;
49        cur[x]:=ins;
50        dec(vh[dis[x]]);
51        if vh[dis[x]]=0 then dis[s]:=t+1;
52        dis[x]:=minh+1;
53        inc(vh[dis[x]]);
54      end;
55     aug:=nf-l;
56   end;
57  procedure print;
58  var i,j:longint;
59   begin
60     if flow<>tot then write(0)
61                  else begin
62                        writeln(1);
63                        for i:=1 to m do
64                        begin
65                         for j:=1 to n do
66                          if map[i,j+m]=0 then write(j,' ');
67                         writeln;
68                        end;
69                       end;
70   end;
71 Begin
72  assign(input,'prog85.in');assign(output,'prog85.out');
73  reset(input);rewrite(output);
74   init;
75   vh[0]:=t+2;
76   while dis[s]<t+1 do inc(flow,aug(s,maxint));
77   print;
78  close(input);close(output);
79 end.

 

转载于:https://www.cnblogs.com/yesphet/p/5236402.html