Listing MONEDE.PAS
Program monede;
const max=3000;
type sir=array[1..max] of Integer ;
var a,p:sir;
mut:array[1..max,1..3] of Integer ;
sf,incep,n,nrmut,i,j,pz,k:Word;
f:Text; med:Longint;

 

procedure Sort(l,r:Word);
var i,j,x,y:Word;
begin
i:=l; j:=r; 
x:=a[(l+r) div 2];
repeat
while a[i]>x do i:=i+1;
while x>a[j] do j:=j-1;
if i<=j 
then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
y:=p[i]; p[i]:=p[j]; p[j]:=y;
Inc(i); Dec(j)
end
until i>j;
if l<j then Sort(l,j);
if i<r then Sort(i,r)
end;

 

procedure pun_deoparte(var n:Word; var a,p:sir);
var i,pz:Word;
begin
pz:=0;
for i:=1 to n do
if a[i]<>med 
then 
begin 
Inc(pz); a[pz]:=a[i]; p[pz]:=p[i] 
end;
n:=pz
end;

 

procedure citire;
var i,pz:Word;
begin
Assign(f,'MONEZI.IN'); Reset(f); Readln(f,n);
med:=0;
for i:=1 to n do 
begin Read(f,a[i]); med:=med+a[i]; p[i]:=i end;
if med mod n <> 0 
then 
begin
Close(f);
Assign(f,'MONEZI.OUT'); Rewrite(f);
Writeln(f,'NU'); Close(f); Halt
end;
med:=med div n;
pun_deoparte(n,a,p);
Close(f)
end;

 

procedure tiparire;
var i:Word;
begin
Assign(f,'MONEZI.OUT'); Rewrite(f);
Writeln(f,nrmut);
for i:=1 to nrmut do 
Writeln(f,mut[i,1],' ',mut[i,2],’ ',
mut[i,3]);
Close(f)
end;

 

Begin
citire;
incep:=1;
sf:=n;
nrmut:=0;
sort(incep,sf);
i:=incep;
while a[i]>med do
begin
j:=sf;
while a[j]<med do
begin
if a[i]+a[j]=2*med 
then
begin
Inc(nrmut);
mut[nrmut,1]:=p[i]; mut[nrmut,2]:=p[j];
mut[nrmut,3]:=med-a[j];
a[i]:=med; a[j]:=med
end;
Dec(j)
end;
Inc(i)
end;
pun_deoparte(n,a,p);
sf:=n;
while sf>incep do
begin
Inc(nrmut);
a[incep]:=a[incep]-med+a[sf];
mut[nrmut,1]:=p[incep]; mut[nrmut,2]:=p[sf];
mut[nrmut,3]:=med-a[sf];
Dec(sf);
if a[incep]=med 
then Inc(incep) 
else
begin
i:=incep+1;
while i<=sf do
begin
if a[incep]+a[i]=2*med 
then
begin
k:=i;
if a[incep]>med 
then j:=incep
else begin j:=i; i:=incep end;
Inc(nrmut);
mut[nrmut,1]:=p[j];
mut[nrmut,2]:=p[i];
mut[nrmut,3]:=med-a[i];
for i:=k+1 to sf do
begina[i-1]:=a[i];p[i-1]:=p[i]end;
Dec(sf); Inc(incep);
i:=sf
end;
Inc(i)
end
end;
i:=incep+1;
while (a[i-1]<a[i]) and (i<=sf) do
begin
k:=a[i-1]; a[i-1]:=a[i]; a[i]:=k;
k:=p[i-1]; p[i-1]:=p[i]; p[i]:=k;
Inc(i)
end
end;
tiparire
End.