记录编号 |
39386 |
评测结果 |
AAAAAAAAAA |
题目名称 |
硬币收集者 |
最终得分 |
100 |
用户昵称 |
IMSL77 |
是否通过 |
通过 |
代码语言 |
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.