记录编号 39386 评测结果 AAAAAAAAAA
题目名称 硬币收集者 最终得分 100
用户昵称 GravatarIMSL77 是否通过 通过
代码语言 Pascal 运行时间 2.117 s
提交时间 2012-07-09 21:29:27 内存使用 30.68 MiB
显示代码纯文本
program coinmn;
type
  integer=longint;
const
  maxn=310;
  maxm=11000;
var
  n,tot:integer;
  env:array[1..maxn,0..1,0..1] of integer;
  ver:array[0..maxm] of integer;
  en,next,tick:array[1..maxn*maxn shl 2] of integer;
  used:array[1..maxn] of boolean;
  mark:array[0..maxm] of boolean;
  Q:array[0..maxm] of integer;
  pre,bef:array[1..maxn,0..maxm] of integer;

  procedure Fopen;
  begin
    assign(input,'coinmn.in'); reset(input);
    assign(output,'coinmn.out'); rewrite(output);
  end;

  procedure Fclose;
  begin
    close(input); close(output);
  end;

  procedure Init;
  var
    i:integer;
  begin
    for i:=1 to n do
      readln(env[i,0,0],env[i,0,1],env[i,1,0],env[i,1,1]);
  end;

  function BFS(depth,u,v:integer):boolean;
  var
    head,tail:integer;
    k,x,y:integer;
  begin
    fillchar(mark,sizeof(mark),true);
    mark[u]:=false;
    head:=1; tail:=2;
    Q[1]:=u;
    repeat
      x:=Q[head];
      k:=ver[x];
      while k>0 do
      begin
        y:=en[k];
        if mark[y] then
        begin
          mark[y]:=false;
          pre[depth,y]:=k; bef[depth,y]:=x;
          if y=v then exit(false);
          Q[tail]:=y;
          inc(tail);
        end;
        k:=next[k];
      end;
      inc(head);
    until head=tail;
    exit(mark[v]);
  end;

  procedure addedge(u,v,t:integer);
  begin
    inc(tot);
    en[tot]:=v; next[tot]:=ver[u]; ver[u]:=tot; tick[tot]:=t;
    inc(tot);
    en[tot]:=u; next[tot]:=ver[v]; ver[v]:=tot; tick[tot]:=t;
  end;

  procedure deleteedge(u,s:integer);
  var
    k,fa:integer;
  begin
    k:=ver[u];
    if k=s then begin ver[u]:=next[k]; exit; end;
    fa:=k; k:=next[k];
    while (k>0) and (k<>s) do
    begin
      fa:=next[fa]; k:=next[k];
    end;
    next[fa]:=next[k];
  end;

  function add(u,v,t,depth:integer):boolean;
  var
    now:integer;
    p,q,r:integer;
    rem1,rem2:integer;
  begin
    if BFS(depth,u,v) then begin addedge(u,v,t); exit(true); end;
    addedge(u,v,t); used[abs(t)]:=true;
    rem1:=tot-1; rem2:=tot;
    now:=v;
    while now<>u do
    begin
      if not used[abs(tick[pre[depth,now]])] then
      begin
        deleteedge(bef[depth,now],pre[depth,now]);
        deleteedge(now,pre[depth,now] xor 1);
        if tick[pre[depth,now]]>0 then begin p:=tick[pre[depth,now]]; q:=1; end
                            else begin p:=-tick[pre[depth,now]]; q:=0; end;
        r:=-tick[pre[depth,now]];
        if add(env[p,q,0],env[p,q,1],r,depth+1) then exit(true)
        else begin
          addedge(bef[depth,now],now,tick[pre[depth,now]]);
          used[abs(tick[pre[depth,now]])]:=true;
        end;
      end;
      now:=bef[depth,now];
    end;
    deleteedge(u,rem1); deleteedge(v,rem2);
    exit(false);
  end;

  procedure Solve;
  var
    i:integer;
    ans:integer;
  begin
    fillchar(ver,sizeof(ver),0);
    fillchar(next,sizeof(next),0);
    ans:=0; tot:=1;
    for i:=1 to n do
    begin
      fillchar(used,sizeof(used),false);
      if add(env[i,0,0],env[i,0,1],i,1) then begin inc(ans); continue; end;
      fillchar(used,sizeof(used),false);
      if add(env[i,1,0],env[i,1,1],-i,1) then inc(ans);
    end;
    writeln(ans shl 1);
  end;

begin
  Fopen;
  repeat
    readln(n);
    if n=0 then break;
    Init;
    Solve;
  until false;
  Fclose;
end.