Cod sursa(job #292240)

Utilizator cristinabCristina Brinza cristinab Data 30 martie 2009 21:45:24
Problema Medie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.49 kb
{medie ONI2006}

var v:array[1..9000] of integer;
    suma:longint;
    f,g:text;
    n:integer;

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

procedure qsort(l,r:integer);
var i,j,x,aux:integer;
begin
i:=l;
j:=r;
x:=v[(l+r) div 2];

repeat

  while x>v[i] do inc(i);
  while x<v[j] do dec(j);

  if i<=j then
     begin
     aux:=v[i];
     v[i]:=v[j];
     v[j]:=aux;
     inc(i);
     dec(j);
     end;

until i>=j;

if i<r then qsort(i,r);
if j>l then qsort(l,j);
end;


function caut_binar(x:longint):longint;
var p,u,mij:integer;
    ok:boolean;
    nr:longint;
begin
p:=1;
u:=n;
ok:=false;
nr:=0;

while (p<=u) and not ok do
      begin
      mij:=(p+u) div 2;
      if x<v[mij] then u:=mij-1
      else if x>v[mij] then p:=mij+1
           else begin
                ok:=true;
                while v[mij]=x do
                      begin
                      inc(nr);
                      inc(mij);
                      end;
                end;
      end;

caut_binar:=nr;
end;

procedure rezolvare;
var i,j:integer;
    x:longint;
begin
suma:=0;

qsort(1,n);

for i:=1 to n-1 do
    for j:=i+1 to n do
        begin
        x:=caut_binar(2*v[j]-v[i]);
        suma:=suma+x;
        end;

end;

procedure afisare;
begin
assign(g,'medie.out'); rewrite(g);
writeln(g,suma);
close(g);
end;

begin
citire;
rezolvare;
afisare;
end.