Cod sursa(job #68078)

Utilizator cezar305Mr. Noname cezar305 Data 26 iunie 2007 13:46:33
Problema Medie Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.56 kb
var a:array[1..9000] of longint;
    b:array[0..9000] of longint;
    f,g:text;
    n,max,i,j:longint;
    nr:int64;
procedure citesc;
 var x:longint;
 begin
  assign(f,'medie.in'); reset(f);
  read(f,n);
  for i:=1 to n do begin
   read(f,a[i]);
   inc(b[a[i]]);
  end;
  close(f);
 end;

begin
 assign(g,'medie.out'); rewrite(g);
 citesc;
 nr:=0;
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if (a[i]+a[j]) and 1=0 then
    if a[i]=a[j] then
     inc(nr,b[a[i]]-2)
    else
     inc(nr,b[(a[i]+a[j]) shr 1]);
 writeln(g,nr);
 close(g);
end.