Cod sursa(job #112840)

Utilizator ionescu88alex ionescu ionescu88 Data 7 decembrie 2007 22:55:13
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.39 kb
var fi,fo:text;
    i,n,j:integer;
    ct,s,nraparitii:longint;
    v:array[1..1000]of integer;
function part(st,dr:integer):integer;
var mij,i,j,aux,s:integer;
begin
  i:=st; j:=dr; s:=-1;
  while i<j do
    begin
     if v[i]>v[j] then
        begin
          aux:=v[i]; v[i]:=v[j]; v[j]:=aux; s:=-s; end;
      if s=1 then inc(i)
             else dec(j);
    end;
  part:=i;
end;
procedure qsort(st,dr:integer);
var p:longint;
begin
  if st<dr then
    begin
      p:=part(st,dr);
      qsort(st,p-1);
      qsort(p+1,dr);
    end;
end;
function cauta(a,b:integer):integer;
var mij,st,dr:integer;
begin
  st:=a; dr:=b;
  while st<=dr do
    begin
      mij:=(st+dr) div 2;
      if v[mij]<=s then
        begin
          st:=mij+1;
          if v[mij+1]>s then begin cauta:=mij; exit; end;
          if mij+1>n then begin cauta:=mij; exit; end;
        end
      else
        dr:=mij-1;
    end;
end;
procedure calc(a,b,poz:integer);
var vl:longint;
begin
  s:=a+b;
  nraparitii:=0;
  vl:=cauta(poz,n);
  if vl>poz then
    nraparitii:=vl-poz;
  inc(ct,nraparitii);
end;
begin
  assign(fi,'nrtri.in'); reset(fi);
  assign(fo,'nrtri.out'); rewrite(fo);
  read(fi,n);
  ct:=0;
  for i:=1 to n do
    read(fi,v[i]);
  qsort(1,n);
  for i:=1 to n-1 do
     for j:=i+1 to n do
       calc(v[i],v[j],j);
  writeln(fo,ct);
  close(fi);
  close(fo);
end.