试题库问题 2011-12-29

算法实现题8-7 试题库问题（习题 8-18）
´问题描述：
假设一个试题库中有n道试题。 每道试题都标明了所属类别。同一道题可能有多个类别
属性。现要从题库中抽取 m 道题组成试卷。并要求试卷包含指定类型的试题。试设计一个
满足要求的组卷算法。
´编程任务：
对于给定的组卷要求，计算满足要求的组卷方案。
´数据输入：
由文件input.txt提供输入数据。 文件第1行有2个正整数n和k (2 <=k<= 20, k<=n<= 1000)
k 表示题库中试题类型总数，n 表示题库中试题总数。第 2 行有 k 个正整数，第 i 个正整数
表示要选出的类型i的题数。这k个数相加就是要选出的总题数m。接下来的n行给出了题
库中每个试题的类型信息。每行的第1 个正整数p表明该题可以属于 p类，接着的 p个数是
该题所属的类型号。
´结果输出:
程序运行结束时，将组卷方案输出到文件 output.txt 中。文件第 i 行输出 “i：”后接类
型i的题号。如果有多个满足要求的方案，只要输出1 个方案。如果问题无解，则输出“No
Solution!”。
输入文件示例  输出文件示例
input.txt 

3 15
3 3 4
2 1 2
1 3
1 3
1 3
1 3
3 1 2 3
2 2 3
2 1 3
1 2
1 2
2 1 2
2 1 3
2 1 2
1 1
3 1 2 3

output.txt 
 
1: 1 6 8 
2: 7 9 10 
3: 2 3 4 5 
 

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

 

Program Stone;
var i,n,m,flow,tot,s,t,le:longint;
    head,vh,dis,cur:array[0..2000]of longint;
    next,date,point:array[-20000..20000]of longint;
 procedure add(x,y,z:longint);
  begin
     inc(le);
     date[le]:=z;
     point[le]:=y;
     next[le]:=head[x];
     head[x]:=le;
     point[-le]:=x;
     next[-le]:=head[y];
     head[y]:=-le;
  end;
 Procedure init;
 var i,j,k,p:longint;
  begin
    readln(m,n);
    s:=0;t:=n+m+1;
    for i:=1 to m do
     begin
       read(j);
       inc(tot,j);
       add(s,i,j);
     end;
    for i:=1 to n do
     begin
       read(p);
       for j:=1 to p do
        begin
          read(k);
          add(k,i+m,1);
        end;
       readln;
       add(i+m,t,1);
     end;
  end;

 function min(a,b:longint):longint;
  begin
    if a<b then min:=a else min:=b;
  end;
 function aug(x,nf:longint):longint;
 var i,j,l,d,minh,ins:longint;
  begin
    if x=t then exit(nf);
    l:=nf;
    i:=cur[x];
    while i<>0 do
     begin
       if (date[i]>0)and(dis[point[i]]+1=dis[x]) then
           begin
             cur[x]:=i;
             d:=aug(point[i],min(l,date[i]));
             dec(date[i],d);
             inc(date[-i],d);
             dec(l,d);
             if (l=0)or(dis[s]=t+1) then exit(nf-l);
           end;
       i:=next[i];
     end;
    if l=nf then
      begin
        minh:=t+1;
        i:=head[x];
        while i<>0 do
         begin
           if (date[i]>0)and(dis[point[i]]<minh) then begin minh:=dis[point[i]];ins:=i;end;
           i:=next[i];
         end;
        cur[x]:=ins;
        dec(vh[dis[x]]);
        if vh[dis[x]]=0 then dis[s]:=t+1;
        dis[x]:=minh+1;
        inc(vh[dis[x]]);
      end;
    aug:=nf-l;
  end;
 procedure print;
 var i,j,k:longint;
  begin
    for i:=1 to m do
     begin
       j:=head[i];
       write(i,':');
       while j<>0 do
        begin
          if (j>0)and(date[j]=0) then write(point[j],' ');
          j:=next[j];
        end;
       writeln;
     end;
  end;
Begin
 assign(input,'prog87.in');assign(output,'prog87.out');
 reset(input);rewrite(output);
   init;
   vh[0]:=t+1;
   for i:=s to t do cur[i]:=head[i];
   while dis[0]<t+1 do inc(flow,aug(s,maxlongint));
   if flow<>tot then write('No Soluntion!')
                else print;
 close(input);close(output);
end.