Cod sursa(job #166333)

Utilizator kaesarioDumi Loghin kaesario Data 27 martie 2008 21:04:07
Problema Salvare Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.39 kb
{$D+,E+,I+,L+,N-,O-,P-,Q-,R-,T-,V+,X+,Y+} 
{$M 16384,0,655360} 
var p,opt,nr,st,en,lo,hi,med,i,j,k,kk,l,m,n,mp:longint; 
fi,fo:text; 
a:array[1..2003,1..2] of longint; 
ok:array[1..2003] of longint; 
dd,start,c,d,sol,t,x:array[1..1003]of integer; 
procedure readdata; 
begin 
assign(fi,'salvare.in'); 
assign(fo,'salvare.out'); 
reset(fi); 
readln(fi,n); 
readln(fi,kk); 
for l:=1 to n-1 do 
begin 
readln(fi,a[l,1],a[l,2]); 
a[n+l-1,1]:=a[l,2]; 
a[n+l-1,2]:=a[l,1]; 
end; 
close(fi); 
end; 
function try:boolean; 
begin 
try:=false; 
fillchar(ok,sizeof(ok),0); 
fillchar(c,sizeof(c),0); 
fillchar(x,sizeof(x),0); 
d:=dd; 
for i:=1 to n do 
t[i]:=9999; 
nr:=0; 
{ bag in coada frunzele si trimit in sus } 
st:=1; 
en:=0; 
for i:=1 to n do 
if d[i]=1 then 
begin 
inc(en); 
c[en]:=i; 
t[i]:=med; 
end; 
while en<n do 
begin 
{ scade gradul vecinului lui st } 
{ daca acesta are gradul 0, il baga in coada } 
i:=c[st]; 
for j:=start[i] to start[i+1]-1 do 
if ok[j]=0 then 
begin 
ok[j]:=1; 
k:=a[j,2]; 
break; 
end; 
dec(d[i]); 
dec(d[k]); 
if t[i]<t[k] then 
t[k]:=t[i]; 
for j:=start[k] to start[k+1]-1 do 
if a[j,2]=i then 
begin 
ok[j]:=1; 
break; 
end; 
if d[k]=1 then 
begin 
t[k]:=t[k]-1; 
if t[k]=0 then 
begin 
x[k]:=1; 
t[k]:=2*med+1; 
nr:=nr+1; 
end; 
inc(en); 
c[en]:=k; 
end; 
inc(st); 
end; 
if nr=0 then 
begin 
nr:=1; 
x[c[en]]:=1; 
end; 
if nr<=kk then 
begin 
try:=true; 
if med<opt then 
begin 
opt:=med; 
sol:=x; 
end; 
end; 
end; 
procedure solve; 
begin 
opt:=n+1; 
m:=2*n-2; 
for i:=1 to m do 
begin 
mp:=i; 
for j:=i+1 to m do 
if (a[j,1]<a[mp,1])or((a[j,1]=a[mp,1])and(a[j,2]<a[mp,2])) then 
mp:=j; 
a[m+1]:=a[mp]; 
a[mp]:=a[i]; 
a[i]:=a[m+1]; 
a[m+1]:=a[m+2]; 
end; 
start[1]:=1; 
j:=1; 
for i:=2 to n do 
begin 
repeat 
inc(j); 
until a[j,1]=i; 
start[i]:=j; 
end; 
start[n+1]:=m+1; 
for i:=1 to n do 
d[i]:=start[i+1]-start[i]; 
dd:=d; 
{ urmeaza cautarea binara } 
lo:=1; 
hi:=n; 
while lo<=hi do 
begin 
med:=(lo+hi)div 2; 
if try then 
hi:=med-1 
else 
lo:=med+1; 
end; 
p:=kk; 
for i:=1 to n do 
p:=p-sol[i]; 
for i:=1 to n do 
if (p>0)and(sol[i]=0) then 
begin 
sol[i]:=1; 
dec(p); 
end; 
if kk=n then 
opt:=0; 
rewrite(fo); 
writeln(fo,opt); 
for i:=1 to n do 
if sol[i]=1 then 
write(fo,i,' '); 
writeln(fo); 
close(fo); 
end; 
begin 
readdata; 
solve; 
end.