Cod sursa(job #167946)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 30 martie 2008 14:06:44
Problema Partitie Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 kb
var c,a,p : array[1..300000] of longint;
    n,d,i,j,max : longint;
    f,g : text;
procedure sort(l,r : longint);
var x,y,i,j : longint;
begin
  i:=l;j:=r;x:=c[(l+r)div 2];
  repeat
    while c[i]<x do inc(i);
    while x<c[j] do dec(j);
      if i<=j then
      begin
        y:=c[i];
        c[i]:=c[j];
        c[j]:=y;
        y:=a[i];
        a[i]:=a[j];
        a[j]:=y;
        inc(i); dec(j);
      end;
  until i>j;
  if l<j then sort(l,j);
  if i<r then sort(i,r);
end;

begin
assign(f,'partitie.in');reset(f);
assign(g,'partitie.out');rewrite(g);
read(f,n,d);
for i:=1 to n do read(f,c[i]);
for i:=1 to n do a[i]:=i;
sort(1,n);
i:=1; j:=1;
  while i<=n do
  begin
    while (c[j]-c[i]<=d-1)and(j<=n) do
    begin
      inc(j);
      if j-i>max then max:=j-i;
    end;
    inc(i);
  end;
writeln(g,max);
j:=0;
for i:=1 to (n div max)*max do
begin
  inc(j);
  j:=j mod max;
  if j=0 then j:=max;
  p[a[i]]:=j;
end;
j:=0;
for i:=(n div max)*max+1 to n do
begin
  inc(j);
  p[a[i]]:=j;
end;
for i:=1 to n do writeln(g,p[i]);
close(g);
end.