记录编号 10051 评测结果 AAAAAAAAAA
题目名称 K- 联赛 最终得分 100
用户昵称 Gravatar苏轼 是否通过 通过
代码语言 Pascal 运行时间 1.075 s
提交时间 2009-04-24 18:58:10 内存使用 3.98 MiB
显示代码纯文本
{
 haoi2009 moni4 t3
 time:2009.4.24
}
program cch(input,output);
var
 p,w,d,a:array[0..3000] of longint;
 map:array[1..30,1..30] of longint;
 g:array[0..1000,0..1000] of longint;
 s,t,n,tot,o:longint;

procedure init;
var
 i,j:integer;
begin
 assign(input,'kleague.in');
 assign(output,'kleague.out');
 reset(input);
 rewrite(output);
 readln(n);
 for i:=1 to n do read(w[i],d[i]);
 for i:=1 to n do
  for j:=1 to n do
   read(map[i,j]);
end;

procedure makegraph(k:integer);
var
 i,j,ch:longint;
 b:array[1..30,1..30] of longint;
begin
 for i:=1 to n do
  for j:=1 to n do
   b[i,j]:=map[i,j];
 ch:=w[k];
 for i:=1 to n do
  begin
   inc(ch,b[k,i]);
   b[k,i]:=0; b[i,k]:=0;
  end;
 fillchar(g,sizeof(g),0);
 o:=n;
 s:=0; t:=n*n+1;
 for i:=1 to n do
  for j:=i+1 to n do
   if b[i,j]>0 then
    begin
     inc(o);
     g[i,o]:=b[i,j]; g[j,o]:=b[i,j];
     g[o,t]:=b[i,j];
    end;
 for i:=1 to n do
  g[s,i]:=ch-w[i];
end;

procedure bfs;
var
 head,tail,i:longint;
 q:array[1..100000] of integer;
begin
 for i:=0 to t do p[i]:=-1;
 p[s]:=0;
 head:=1; tail:=1;
 q[head]:=s;
 repeat
  for i:=0 to t do
   if (p[i]=-1)and(g[q[head],i]>0) then
    begin
     inc(tail); q[tail]:=i;
     p[i]:=p[q[head]]+1;
    end;
  inc(head);
 until head>tail;
end;

procedure dinic;
var
 l,k,i,flow:longint;
 flag:boolean;
 stack,last:array[0..3000] of integer;
begin
 while true do
  begin
   bfs;
   if p[t]=-1 then break;
   for i:=s to t do last[i]:=0;
   l:=1; stack[l]:=s;
   while l<>0 do
    begin
     k:=stack[l];
     if k<>t then
      begin
       flag:=true;
       for i:=last[k]+1 to t do
        if (p[k]+1=p[i])and(g[k,i]>0) then
         begin
          flag:=false;
          inc(l); stack[l]:=i;
          last[k]:=i;
          break;
         end;
       if flag then
        begin
         p[k]:=-100; dec(l);
        end;
      end
     else
      begin
       flow:=maxlongint;
       for i:=2 to l do
        if flow>g[stack[i-1],stack[i]] then
         flow:=g[stack[i-1],stack[i]];
       k:=0;
       for i:=2 to l do
        begin
         dec(g[stack[i-1],stack[i]],flow);
         inc(g[stack[i],stack[i-1]],flow);
         if (k=0)and(g[stack[i-1],stack[i]]=0) then
          begin
           k:=i-1;
          end;
        end;
       l:=k;
      end;
     end;
    end;
end;

function check(k:integer):boolean;
var
 i,j:integer;
begin
 makegraph(k);
 for i:=1 to n do
  if g[s,i]<0 then exit(false);
 dinic;
 for i:=n+1 to o do
  if g[i,t]>0 then
    exit(false);
 exit(true);
end;

procedure main;
var
 i:integer;
begin
 fillchar(a,sizeof(a),0);
 tot:=0;
 for i:=1 to n do
  if check(i) then
   begin
    inc(tot);
    a[tot]:=i;
   end;
end;

procedure print;
var
 i:integer;
begin
 for i:=1 to tot-1 do write(a[i],' ');
 writeln(a[tot]);
 close(input);
 close(output);
end;

begin
 init;
 main;
 print;
end.