Cod sursa(job #59952)

Utilizator andrei_infoMirestean Andrei andrei_info Data 11 mai 2007 13:25:09
Problema Medie Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.89 kb
const max = 9000;
type vect = array[0..max] of integer;

var n:integer;
    a,c,nr:vect;
    mm:longint;

procedure citire;
var i:integer;
begin
assign(input,'medie.in'); reset(input);
readln(n);
for i:=1 to n do
    begin
    readln(a[i]);
    c[a[i]]:=c[a[i]]+1;
    end;
close(input);
end;

{procedure sort(var a:vect);
var i:integer;

begin

for i:=0 to max do
         c[i]:=0;
for i:=1 to n do c[a[i]]:=c[a[i]]+1;
d:=c;
for i:=1 to max do c[i]:=c[i]+c[i-1];

for i:=1 to n do
                begin
                b[c[a[i]]]:=a[i];
                c[a[i]]:=c[a[i]]-1;
                end;
a:=b;
end; }

function comb(m:integer):longint;
var a:longint;
begin
a:=m*(m-1);
a:=a div 2;
comb:=a;
end;

procedure identice;
var i:integer;
begin
for i:=1 to max do
    if c[i] >= 3 then mm:=mm+c[i]*comb(c[i]-1);
end;


procedure calc;
var i,j,k,nrd:integer;
begin
nrd:=0;
for i:=1 to max do
         if c[i] <> 0 then begin
                           nrd:=nrd+1;
                           nr[nrd]:=i;
                           end;
for i:=2 to nrd-1 do
    begin
    j:=i+1;
    while j <= nrd do
          begin
          if 2*nr[i] - nr[j] > 0 then
          begin
          if c[2*nr[i]-nr[j]] <> 0 then mm:=mm+c[nr[j]]*c[nr[2*nr[i]-nr[j]]];
          if (nr[j]) > 2*nr[i] then j:=nrd+1;
          end;


          {while k <= nrd do
                begin
                if ((nr[j]+nr[k]) mod 2 = 0 ) and ((nr[j]+nr[k]) div 2 = nr[i]) then
                               mm:=mm+c[nr[j]]*c[nr[k]];
                if (nr[j]+nr[k]) > 2*nr[i] then k:=nrd+1;
                k:=k+1;
                end;}
         j:=j+1;
         {if (nr[j] + nr[nrd] < 2*nr[i]) then j:=0;}
         end;
    end;
end;

begin
citire;
mm:=0;
{sort(a);}
identice;
calc;
assign(output,'medie.out'); rewrite(output);
writeln(mm);
close(output);

end.