Cele mai bune solutii
pentru problema "Monezi"
(ziua1, problema1)
Autorul problemei " Monezi" este conf. dr. Radu Marsanu, A.S.E. Bucuresti
Punctaj Maxim : 50 puncte
Solutii :
Sauciuc Raluca - Bucuresti - 20 puncte
Stefan Radu - Brasov - 20 puncte
Prihoi Ovtav - Sibiu - 20 puncte
Bratu Bogdan - Timis - 20 puncte
Zamfirescu Cristian - Dolj - 20 puncte
Anghel Marian - Ilfov - 20 puncte
Sauciuc Raluca - Bucuresti - 20 puncte
Dinca Sergiu
Comisia Centrala
Fisierele de teste
Program realizat de elevul Sauciuc Raluca - rezultat final : premiu III - 127 puncte
Program monezi;
var a,b:array[1..2000] of longint;
s,nrm,min,med,max,aux:longint;
n,i,poz,poz1:integer;
f:text;
procedure load;
begin
assign(f,'monezi.in'); reset(f);
readln(f,n);
for i:=1 to n do readln(f,a[i]);
close(f);
end;
function gata:boolean;
begin
s:=0;
for i:=1 to n do s:=s+a[i];
med:=s div n;
gata:=(s mod n<>0);
end;
function minim(x,y:longint):longint;
begin
if x<=y then minim:=x else minim:=y;
end;
begin
load;
if not gata then
begin
for i:=1 to n do b[i]:=a[i]-med;
nrm:=0;
min:=maxlongint;
poz:=0;
for i:=1 to n do
if (b[i]<min) and (b[i]<>0) then begin min:=b[i]; poz:=i; end;
while poz<>0 do
begin
max:=0;
for i:=1 to n do
if (max<b[i]) then
begin
max:=b[i];
poz1:=i;
end;
nrm:=nrm+1;
aux:=minim(abs(b[poz]),b[poz1]);
b[poz]:=b[poz]+aux;
b[poz1]:=b[poz1]-aux;
min:=maxlongint;
poz:=0;
for i:=1 to n do
if (b[i]<min) and (b[i]<>0) then begin min:=b[i]; poz:=i; end;
end;
assign(f,'monezi.out'); rewrite(f);
writeln(f,nrm);
for i:=1 to n do b[i]:=a[i]-med;
nrm:=0;
min:=maxlongint;
poz:=0;
for i:=1 to n do
if (b[i]<min) and (b[i]<>0) then begin min:=b[i]; poz:=i; end;
while poz<>0 do
begin
max:=0;
for i:=1 to n do
if (max<b[i]) then
begin
max:=b[i];
poz1:=i;
end;
nrm:=nrm+1;
aux:=minim(abs(b[poz]),b[poz1]);
b[poz]:=b[poz]+aux;
b[poz1]:=b[poz1]-aux;
writeln(f,poz1,' ',poz,' ',aux);
min:=maxlongint;
poz:=0;
for i:=1 to n do
if (b[i]<min) and (b[i]<>0) then begin min:=b[i]; poz:=i; end;
end;
close(f);
end
else
begin
assign(f,'monezi.out'); rewrite(f);
writeln(f,'NU');
close(f);
end;
end.
Program realizat de Comisia Centrala a Olimpiadei Nationale de Informatica
program monezi;
const max=3000;
var a:array[1..max] of integer;
p:array[1..max] of integer;
mut:array[1..max,1..3] of integer;
sf,incep,n,nrmut:integer;
f:text;
med:longint;
procedure Sort(l, r: Integer);
var
i, j, x, y: integer;
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;
i := i + 1; j := j - 1;
end;
until i > j;
if l < j then Sort(l, j);
if i < r then Sort(i, r);
end;
procedure citire;
var i,pz:integer;
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;
pz := 0;
for i:=1 to n do
if a[i]<>med then begin
inc(pz);
a[pz]:=a[i];
end;
n:=pz;
close(f);
end;
procedure tiparire;
var i:integer;
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;
while sf>incep do
begin
sort(incep,sf);
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);
end;
tiparire;
end.
Fisierele de teste :
Test 1 :
6
13
13
13
12
6
3
Test 2 :
100
539
878
441
865
997
756
449
1016
1088
524
1066
604
1122
1076
831
799
1131
468
956
591
518
958
1131
958
630
1001
800
404
1021
502
401
721
1190
684
466
1199
599
907
644
532
1144
569
962
1049
463
828
591
516
691
1089
823
938
621
582
723
802
1081
1181
567
602
699
597
1143
481
1053
470
792
1022
1193
523
1102
835
916
492
1120
767
1187
583
973
791
691
983
801
584
508
1179
1070
652
1091
802
961
1040
742
748
526
451
963
1111
494
79