Cod sursa(job #473232)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 28 iulie 2010 14:24:05
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.09 kb
var i,j,n,aux,k:integer;
v:array[1..1000]of integer;
c,x:longint;

procedure sort(a,b:integer);
var i,j,mij:integer;
begin
i:=a;
j:=b;
mij:=v[(a+b)div 2];
repeat
while v[i]<mij do inc(i);
while v[j]>mij 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 a<j then sort(a,j);
if i<b then sort(i,b);
end;

function caut(x:longint):integer;
var a,b,mij,rez:integer;
begin
a:=j+1; b:=n;
while a<=b do begin
      mij:=(a+b) div 2;
      if v[mij]<=x then begin
                        a:=mij+1;
                        rez:=mij;
                        end
                   else b:=mij-1;
      end;
caut:=rez;
end;


begin
assign(input,'nrtri.in');reset(input);
assign(output,'nrtri.out');rewrite(output);
read(n);
for i:=1 to n do read(v[i]);

sort(1,n);

c:=0;
for i:=1 to n-2 do
    for j:=i+1 to n-1 do begin
        x:=v[i]+v[j];
        k:=caut(x);
        if k>j then begin
           if k<=n then c:=c+k-j
                   else c:=c+n-j;
           end;
    end;
write(c);
close(output);
end.