Cod sursa(job #61904)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 20 mai 2007 23:59:08
Problema Medie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.83 kb
var f,g:text;
x:array[1..9000] of longint;
a,c:array[1..7000] of longint;
max,n,i,j,k,l:longint;
function min(a,b:longint):longint;
begin
if a<b then min:=a
        else min:=b;
end;
begin
assign(f,'medie.in');
assign(g,'medie.out');
reset(F);
rewrite(G);
readln(f,n);
max:=0;
for i:=1 to n do
    begin
    readln(f,l);
    inc(a[l]);
    if a[l]=1 then begin
                        inc(k);
                        x[k]:=l;
                        end;
    end;
n:=k;
for i:=1 to n-1 do
for j:=i+1 to n do
        if (x[i]+x[j]) mod 2=0 then
        c[(x[i]+x[j]) div 2]:=c[(x[i]+x[j])div 2]+a[x[i]]*a[x[j]];
k:=0;
for i:=1 to n do
     begin
     l:=x[i];
     j:=a[l];
     if j>2 then
     k:=k+(j*(j-1)*3) div 2+j*c[l]

     else k:=k+a[l]*c[l];
     end;

writeln(g,k);
close(F);
close(G);
end.