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.