Listing MONEDE.PAS
Program
constmax=3000;
typesir=array[1..max] of Integer ;
vara,p:sir;
mut:array[1..max,1..3] of Integer ;
sf,incep,n,nrmut,i,j,pz,k:Word;
f:Text; med:Longint;
procedureSort(l,r:Word);
vari,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);
vari,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;
procedurecitire;
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.