Cod sursa(job #68199)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 26 iunie 2007 22:10:16
Problema Medie Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.98 kb
var n,i,j,x,max : integer;
    nr,p : qword;
    a : array[1..9005] of integer;
    f,g : text;

begin
assign(f,'medie.in'); reset(f);
assign(g,'medie.out'); rewrite(g);
readln(f,n); max:=0;
for i:=1 to n do begin
         readln(f,x);
         if x>max then max:=x;
         inc(a[x]);
                 end;

n:=max+2;
for i:=1 to n-2 do begin
  if a[i]>=1 then begin
                       j:=i+1;
                              repeat
                                 while (j<=n) and (a[j]<1) do inc(j);
                                 if (2*j-i<=n) and (a[2*j-i]>=1) then nr:=nr+a[i]*a[2*j-i];
                              inc(j);
                              until j>=n;
                       if a[i]>=3 then begin
                                        p:=(a[i] *(a[i]-1)*(a[i]-2)) DIV 2;
                                        nr:=nr+p;
                                       end;
                  end;
                   end;
writeln(g,nr);
close(g);
end.