Cod sursa(job #124942)

Utilizator borsosborsos adrian borsos Data 20 ianuarie 2008 10:31:07
Problema Partitie Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasa a 10-a Marime 1.55 kb
var f,k:text;
a,gr:array[1..300000]of longint;
n,d,grupa,i,j,g:longint;
ok,ok1:boolean;
begin
assign(f,'partitie.in'); reset(f);
assign(k,'partitie.out'); rewrite(k);

readln(f,n,d);
readln(f,a[1]); gr[1]:=1;
grupa:=1;
for i := 2 to n do begin
           readln(f,a[i]);
           g:=1; ok1:=false; ok:=false;
           while ((not ok1) or (not ok))and(gr[i]=0) do  begin
               ok:=false;
               for j := 1 to i-1 do begin
                 if gr[j]=g then begin
                          if a[i]>a[j] then begin
                                   if a[i]-a[j]>=d then
                                               ok:=true else
                                               begin inc(g);ok1:=false; end;
                                            end else
                          if a[i]<a[j] then begin
                                   if a[j]-a[i]>=d then
                                               ok:=true else
                                               begin inc(g);ok1:=false; end;
                                            end;
                                 end;
                                     end;
               if ok=true then gr[i]:=g;
                 if g>grupa then begin
                            gr[i]:=g;      {dak fac o noua grupa}
                            grupa:=g;
                                 end;
                            end; {end while ok}
                     end; {end for 1 to n}
writeln(k,grupa);
for i := 1 to n do writeln(k,gr[i]);
close(f);
close(k);

end.