记录编号 54903 评测结果 AAAAAAAAAA
题目名称 [CTSC 1999][网络流24题] 星际转移 最终得分 100
用户昵称 GravatarCAX-DY 是否通过 通过
代码语言 Pascal 运行时间 0.009 s
提交时间 2013-03-13 21:31:47 内存使用 1.35 MiB
显示代码纯文本
uses math;
const ss=2111; ed=2131; oo=19961002;
var n,m,all,i,j,k,pt,nn,t:longint; h,s:array[1..50]of longint; v:array[-1..2150]of boolean;
    w:array[1..20,1..1000]of longint; q:array[1..100000]of longint;
    a,d,vd:array[-1..2150]of longint; p,pre,c:array[0..50000]of longint;
function dtn(x,y:longint):longint; begin exit(x*nn+y); end;
function stop(x,y:longint):longint; begin stop:=x mod y; exit(stop+1); end;
procedure link(x,y,z:longint);
begin
 inc(pt); p[pt]:=y; pre[pt]:=a[x]; a[x]:=pt; c[pt]:=z;
 inc(pt); p[pt]:=x; pre[pt]:=a[y]; a[y]:=pt; c[pt]:=0;
end;
procedure build(d:longint); var i,j,k:longint;
begin
 for i:=-1 to n do
  for j:=1 to m do
   if w[j,stop(d,s[j])]=i then
    link(dtn(d,i),dtn(d+1,w[j,stop(d+1,s[j])]),h[j]);
 for i:=-1 to n do link(dtn(d,i),dtn(d+1,i),oo);
 link(dtn(d+1,-1),ed,oo); link(ss,dtn(d+1,0),oo);
end;
procedure init;
begin
 readln(n,m,all); pt:=-1; fillchar(a,sizeof(A),255); nn:=n+2;
 for i:=1 to m do
  begin
   read(h[i],s[i]);
   for j:=1 to s[i] do
    read(w[i,j]);
   readln;
  end;
  link(dtn(0,-1),ed,oo); link(ss,dtn(0,0),oo);
end;
function sap(x,y:longint):longint; var i,j,k:longint;
begin
 if x=ed then exit(y); sap:=0; i:=a[x];
 while i<>-1 do
  begin
   j:=p[i];
   if(c[i]>0)and(d[x]=d[j]+1)then
    begin
     k:=sap(j,min(y-sap,c[i]));
     dec(c[i],k); inc(c[i xor 1],k); inc(sap,k); if sap=y then exit;
    end;
   i:=pre[i];
  end;
 if d[ss]=t*nn+2 then exit; dec(vd[d[x]]); if vd[d[x]]=0 then d[ss]:=t*nn+2;
 inc(d[x]); inc(vd[d[x]]);
end;
procedure bfs; var h,t,i,j,k:longint;
begin
 fillchar(v,sizeof(v),false); fillchar(vd,sizeof(vd),0);
 h:=1; t:=1; q[1]:=ed; v[ed]:=true; d[ed]:=0; vd[0]:=1;
 while h<=t do
  begin
   i:=q[h]; j:=a[i];
   while j<>-1 do
    begin
     k:=p[j];
     if not v[k] then
      begin
       v[k]:=true; inc(t); q[t]:=k; d[k]:=d[i]+1; inc(vd[d[k]]);
      end;
     j:=pre[j];
    end;
   inc(h);
  end;
end;
procedure work; var u:longint;
begin
 t:=0; u:=0;
 repeat
  inc(t); build(t-1);
  bfs; if d[ss]<>0 then
  while d[ss]<t*nn+2 do inc(u,sap(ss,oo));
 until(u>=all)or(t>m*n+1);
 if u>=all then write(t) else write(0);
end;
begin
assign(input,'home.in'); assign(output,'home.out'); reset(input); rewrite(output);
 init;
 work;
close(input); close(output);
end.