Cod sursa(job #59591)

Utilizator edu2004euLuca Eduard edu2004eu Data 9 mai 2007 19:26:55
Problema Salvare Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.47 kb
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.