[an error occurred while processing this directive]
Listing REDUCERI.PAS
{$M 65521,0,655360 }
Program Reduceri;
var a,reduc:array[1..100] of Integer;
n,t:Integer;
f:Text;
procedure Citire;
var i:Integer;
begin
Assign(f,'SUBTRACT.IN'); Reset(f);
Readln(f,n,t);
for i:=1 to n do Readln(f,a[i]);
Close(f)
end;
procedure Scriere;
var i:Integer;
begin
Assign(f,'SUBTRACT.OUT'); Rewrite(f);
for i:=1 to n-1 do
Writeln(f,reduc[i]);
Close(f)
end;
procedure Solutie;
var r:array[1..100] of Integer;
sume:array[0..20000] of Integer;
sum,scop:Integer;
i,j,nr,poz,contor,cont:Integer;
begin
{ Calculul sumelor posibile }
sum:=0;
for i:=1 to n do
Inc(sum,a[i]);
scop:=t+sum-2*a[1];
sume[0]:=-1;
for i:=1 to scop do sume[i]:=-2;
for i:=3 to n do
begin
for j:=scop-1 downto 0 do
if sume[j]<>-2
then
begin
if sume[j+2*a[i]]=-2
then sume[j+2*a[i]]:=i;
if sume[scop]<>-2 then Break
end;
if sume[scop]<>-2 then Break
end;
{ Calculul coeficientilor r }
r[1]:=1; r[2]:=-1;
for i:=3 to n do r[i]:=-1;
nr:=scop;
repeat
if nr=0 then Break;
r[sume[nr]]:=1; nr:=nr-2*a[sume[nr]]
until false;
{ Calculul pozitiilor pe care } { se fac reducerile }
poz:=n; contor:=0;
repeat
while r[poz]=-1 do Dec(poz);
if poz=1 then Break;
cont:=0;
while r[poz]=1 do
begin
Dec(poz);
Inc(cont)
end;
for i:=1 to cont do
begin
Inc(contor);
reduc[contor]:=poz
end;
Dec(poz)
until false;
for i:=1 to n-1-contor do
begin
Inc(contor);
reduc[contor]:=1
end
end;
Begin
Citire;
Solutie;
Scriere
End.