Cod sursa(job #57446)

Utilizator ionescu_bogdanIonescu Bogdan-Gabriel ionescu_bogdan Data 2 mai 2007 09:03:13
Problema Salvare Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.71 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.