Listing NUCLEE.PAS
Program nuclee;
Const inputname='NUC.IN';
outputname='NUC.OUT';
Type sir=array[0..255] of Longint;
Var f,g:Text;
a:array[0..255] of ^sir;
s,k,t:Longint;
Procedure Citire;
Var x:Word;
begin
Assign(f,inputname); Reset(f);
Readln(f,s,k);
while not Seekeof(f) do
begin
Read(f,x);
Inc(a[x div 256]^[x mod 256])
end;
Close(f)
end;
Procedure Initializari;
Var i:Byte;
begin
for i:=0 to 255 do
begin
New(a[i]);
Fillchar(a[i]^,Sizeof(a[i]^),0)
end
end;
Procedure Calcul;
Var totaL:Word;
i,decr,x,y:Longint;
begin
total:=s;
decr:=0;
if a[k div 256]^[k mod 256]>total
then a[k div 256]^[k mod 256]:=total;
Dec(total,a[k div 256]^[k mod 256]);
while total>0 do
begin
Inc(decr);
x:=decr+k;
y:=-decr+k;
if x<65000
then
begin
if a[x div 256]^[x mod 256]>total
then a[x div 256]^[x mod 256]:=total;
Dec(total,a[x div 256]^[x mod 256])
end;
if y>0
then
begin
if a[y div 256]^[y mod 256]>total
then a[y div 256]^[y mod 256]:=total;
Dec(total,a[y div 256]^[y mod 256])
end
end;
for i:=1 to 65000 do
if Abs(i-k)>decr
then a[i div 256]^[i mod 256]:=0
end;
Procedure Afisare;
Var x,c:Word;
begin
Assign(f,inputname);
Reset(f);
Assign(g,outputname);
Rewrite(g);
Readln(f);
c:=0;
while not Seekeof(f) do
begin
Read(f,x);
if a[x div 256]^[x mod 256]>0
then
begin
Write(g,x,' ?);
Inc(c);
if c mod 50 = 0 then Writeln(g);
Dec(a[x div 256]^[x mod 256])
end
end;
Close(g)
end;
Begin
Initializari;
Citire;
Calcul;
Afisare
End.