Cod sursa(job #125054)

Utilizator razvan_emPrecupas Razvan razvan_em Data 20 ianuarie 2008 11:07:58
Problema Partitie Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasa a 10-a Marime 1.29 kb
program partitii;
type vect=array [1..1000] of -1..65536;
var f,g:text;
    u,m,x:vect;
    ordine,nr:array [1..255] of byte;
    n,d,w,z,a:word;
    nrp:byte;

procedure eliminare(p:word);
var i,j:word;
begin
for i:=1 to p do
for j:=1 to w do
if i=nr[j] then x[i]:=-1;
end;

procedure verificare(p:word);
var i,j:word; k:word;
begin
k:=0;
for i:=1 to p-1 do
for j:=i+1 to p do
if abs(x[i]-x[j])<d then
begin
k:=k+1;
nr[k]:=j;
end;  w:=k;
if k<>0 then eliminare(p);
end;

procedure finalizare;
var i,j:word;
begin
nrp:=nrp+1;
j:=0;
for i:=1 to z do
if x[i]<>-1 then
begin
j:=j+1;
u[j]:=x[i];
ordine[u[j]]:=nrp;
end; end;

procedure tipar;
var i:word;
begin
write(g,nrp);
for i:=1 to n do
writeln(g,ordine[m[i]]);
end;

procedure inceput;
var l,o:word;
begin
l:=1;
while l<=n do
if m[l]<>-1 then
begin
x[1]:=m[l];
l:=n+1;
end;
z:=1;
for l:=2 to n do
if m[l]<>-1 then
if abs(m[1]-m[l])>=d then
begin
z:=z+1;
x[z]:=m[l];
end;
verificare(z);
finalizare;
for l:=1 to n do
begin
o:=1;
while o<=z do
if m[l]=x[o] then
begin
m[l]:=-1;
o:=z+1;
end; end; end;

begin
assign(f,'partitie.in'); reset(f);
assign(g,'partitie.out'); rewrite(g);
read(f,n,d);
for a:=1 to n do
readln(f,m[a]);
inceput;
nrp:=0;
tipar;
close(f); close(g);
end.