Cod sursa(job #12868)

Utilizator Agent_SmithSilaghi Raul Agent_Smith Data 5 februarie 2007 08:52:09
Problema Hotel Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.02 kb
program hotel;
{D.P.A.}
type vecT=array[1..1000]of integer;
     vec=array[1..700]of integer;

var c,e,x,o:vecT;
    n,k:integer;
    f:text;

procedure  suma1(x:vec;dx:integer;y:vec;dy:integer;var z:vec;var dz:integer);
var i,mi,dt,tr:integer;t:vec;
begin
if dx>dy then
 begin
  for i:=1 to dx-dy do
   t[i]:=0;
  dt:=dx-dy;
  for i:=1 to dy do
   begin
    inc(dt);
    t[dt]:=y[i];
   end;
  for i:=1 to dt do
   y[i]:=t[i];
  dy:=dx;
 end
         else
 if dy>dx then
  begin
   for i:=1 to dy-dx do
    t[i]:=0;
   dt:=dy-dx;
   for i:=1 to dx do
    begin
    inc(dt);
    t[dt]:=x[i];
    end;
   for i:=1 to dt do
    x[i]:=t[i];
   dx:=dy;
  end;
dt:=0;
mi:=0;
for i:=dx downto 1 do
 begin
  inc(dt);
  tr:=x[i]+y[i]+mi;
  t[dt]:=tr mod 10;
  mi:=tr div 10;
 end;
if mi>0 then
 begin
  inc(dt);
  t[dt]:=mi;
 end;
for i:=1 to dt do
 z[i]:=t[dt+1-i];
dz:=dt;
end;{suma}

procedure produs1(x:vec;dx:integer;y:vec;dy:integer;var z:vec;var dz:integer);
var i,j,k,dt,du:integer;t,u:vec;
begin
dz:=1;z[1]:=0;
for i:=1 to dy do
begin
 t[1]:=0;dt:=1;
 for j:=1 to y[dy-i+1] do
  begin
   suma1(x,dx,t,dt,u,du);
   dt:=du;
   for k:=1 to du do t[k]:=u[k];
  end;
 for j:=1 to i-1 do
  begin
   inc(dt);
   t[dt]:=0;
  end;
 suma1(z,dz,t,dt,u,du);
 dz:=du;
 for j:=1 to du do z[j]:=u[j];
end;
end;{produs}



procedure readdata;
var f:text;
    i:integer;
begin
assign(f,'hotel.in');reset(f);
readln(f,n,k);
for i:=1 to n do
begin
readln(f,c[i],e[i]);
o[i]:=i;
end;
close(f);
end;

procedure sort(lo,hi:integer);
var k:integer;

 procedure pos(lo,hi:integer;var k:integer);
 var i,j:integer;aux:longint;
 begin
 i:=lo;j:=hi;
 while (i<j) do
 begin
 while ((i<j) and (e[o[i]]<=e[o[j]])) do inc(i);
 while ((i<j) and (e[o[i]]<=e[o[j]])) do dec(j);
 aux:=o[i];o[i]:=o[j];o[j]:=aux;
 end;
 k:=i;
 end;

begin
if lo<hi then
 begin
 pos(lo,hi,k);
 sort(lo,k-1);
 sort(k+1,hi);
 end;
end;

procedure transf(p:integer;var v:vec;var dv:integer);
var i,aux:integer;
begin
dv:=0;
while p<>0 do
begin
 inc(dv);
 v[dv]:=p mod 10;
 p:=p div 10;
end;
for i:=1 to dv div 2 do
 begin
  aux:=v[i];
  v[i]:=v[dv-i+1];
  v[dv-i+1]:=v[i];
 end;

end;

procedure numar;
var i,j,dr,dx:integer;
    nr,dy:integer;
    rez,x,y:vec;
begin
j:=1;
for i:=2 to n do
if e[o[i]]<>e[o[i-1]] then inc(j);
nr:=1;
for i:=1 to 500 do rez[i]:=0;
dr:=1;rez[1]:=1;
for i:=k downto (k-j+1) do
begin
transf(i,x,dx);

produs1(rez,dr,x,dx,y,dy);
rez:=y;
dr:=dy;
end;
for i:=1 to dr do write(f,rez[i]);
writeln(f);
end;

procedure rezolvare;
var i,j,cl:integer;
begin
assign(f,'hotel.out');
rewrite(f);
j:=1;
for i:=2 to n do
if e[o[i]]<>e[o[i-1]] then inc(j);
if k<j then writeln(f,'0')
else
begin
x[o[1]]:=1;cl:=1;
for i:=2 to n do
if e[o[i]]=e[o[i-1]] then x[o[i]]:=x[o[i-1]]
else
 begin
 inc(cl);
 x[o[i]]:=cl;
 end;
numar;
for i:=1 to n do writeln(f,c[i],' ',x[i]);

end;
close(f);
end;


begin
readdata;
sort(1,n);
rezolvare;
end.