比赛 |
2008haoi模拟训练4 |
评测结果 |
EEEEEEEEEE |
题目名称 |
遗传密码 |
最终得分 |
0 |
用户昵称 |
cuixiaofei |
运行时间 |
0.000 s |
代码语言 |
Pascal |
内存使用 |
0.00 MiB |
提交时间 |
2008-04-24 17:21:31 |
显示代码纯文本
//na :cuixiaofei;
//da :08_04_24;
program pie;
type
sss =record
ge :array[1..1000,1..2] of longint;
s,shu:longint;
end;
var
a :array[1..1000] of sss;
zuida,n,jilu,shuchu :longint;
f1,f2 :text;
procedure init;
var
i,a1,a2 :longint;
begin
assign(f1,'pie.in');
reset(f1);
assign(f2,'pie.out');
rewrite(f2);
fillchar(a,sizeof(a),0);
readln(f1,n);
shuchu:=n;
jilu:=n;
zuida:=0;
for i:=1 to n do
begin
readln(f1,a1,a2);
inc(a[a1].shu);
inc(a[a1].s);
a[a1].ge[a[a1].shu,1]:=a2;
if a1>zuida then
zuida:=a1;
if a2>zuida then
zuida:=a2;
end;
end;
function panhuan(k:longint):longint;
var
tui :longint;
pc :array[1..1000] of longint;
procedure sousuo(mmm,c:longint);
var
i :longint;
begin
if (mmm=k) and (c<>1) then
begin
panhuan:=1;
tui:=1;
exit;
end
else
begin
for i:=1 to a[mmm].shu do
if (a[mmm].ge[i,2]=0)and(pc[a[mmm].ge[i,1]]=0) then
begin
if tui=1 then
exit;
pc[a[mmm].ge[i,1]]:=1;
sousuo(a[mmm].ge[i,1],c+1);
pc[a[mmm].ge[i,1]]:=0;
end;
end;
end;
begin
panhuan:=0;
fillchar(pc,sizeof(pc),0);
sousuo(k,1);
end;
procedure guangsou(k:longint);
var
gs :array[0..1000,1..2] of longint;
st,ed,i :longint;
begin
fillchar(gs,sizeof(gs),0);
st:=1;
ed:=1;
gs[1,1]:=k;
while st<=ed do
begin
for i:=1 to a[k].shu do
if a[k].ge[i,2]=0 then
begin
inc(ed);
gs[ed,1]:=a[k].ge[i,1];
gs[ed,2]:=st;
end;
inc(st);
end;
while gs[ed,2]<>0 do
begin
for i:=1 to a[gs[gs[ed,2],1]].shu do
if a[gs[gs[ed,2],1]].ge[i,1]=gs[ed,1] then
begin
a[gs[gs[ed,2],1]].ge[i,2]:=1;
dec(jilu);
dec(a[gs[gs[ed,2],1]].s);
exit;
end;
ed:=gs[ed,2];
end;
end;
procedure main;
var
i,mmm,jj,panduan :longint;
jihe :array[1..1000] of longint;
begin
while jilu>0 do
begin
inc(shuchu);
mmm:=0;
jj:=0;
panduan:=0;
fillchar(jihe,sizeof(jihe),0);
while panduan=0 do
begin
for i:=1 to n do
if a[i].s>mmm then
begin
mmm:=a[i].s;
jj:=i;
end;
if panhuan(jj)=1 then
begin
jihe[jj]:=1;
panduan:=0;
end
else
panduan:=1;
guangsou(jj);
end;
end;
end;
procedure print;
var
i,j :longint;
begin
writeln(f2,shuchu);
close(f2);
close(f1);
end;
begin
init;
main;
print;
end.