Cod sursa(job #125057)

Utilizator al3csutzuSirbu Alexandru al3csutzu Data 20 ianuarie 2008 11:08:26
Problema Partitie Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasa a 10-a Marime 1.49 kb
program partitie;
var a,poz,max:array[1..300000] of longint;
f,g:text;
n,i,d,j,k,dimh:longint;
gasit:boolean;

procedure repair(i:longint);
var l,r,max,aux:longint;
begin
        l:=2*i;
        r:=l+1;
        max:=i;
        if (l<=dimh)and(a[l]>a[max]) then
                max:=l;
        if (r<=dimh)and(a[r]>a[max]) then
                max:=r;
        if max<>i then
        begin
                aux:=a[i];
                a[i]:=a[max];
                a[max]:=aux;
                repair(max);
        end;
end;

procedure buildheap(h:longint);
var i:longint;
begin
        for i:=h div 2 downto 1 do
                repair(i);
end;

procedure heapsort(h:longint);
var i,aux:longint;
begin
        buildheap(h);
        for i:=h downto 2 do
        begin
                aux:=a[1];
                a[1]:=a[i];
                a[i]:=aux;
                dec(dimh);
  	  repair(1);
        end;
end;

begin
  assign(f,'partitie.in'); assign(g,'partitie.out');
  reset(f); rewrite(g);

  read(f,n,d);
  for i:=1 to n do read(f,a[i]);
  dimh:=n;
  heapsort(n);
  poz[1]:=1; max[1]:=a[1]; j:=1;
  for i:=2 to n do
  begin
    gasit:=false;
    k:=0;
    while (k<j) and (gasit=false) do
    begin
      k:=k+1;
      if a[i]>=max[k]+d then begin poz[i]:=k; max[k]:=a[i]; gasit:=true; end;
    end;
    if gasit=false then begin j:=j+1; poz[i]:=j; max[j]:=a[i]; end;
  end;
  writeln(g,j);
  for i:=1 to n do writeln(g,poz[i]);
  close(f); close(g);
end.