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.

[BACK]


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.

[BACK]


 

 

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

[BACK]