Cod sursa(job #17513)

Utilizator hitmannCiocas Radu hitmann Data 16 februarie 2007 01:43:47
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
program numtri;
var v:Array[1..800]of integer;
    n,i,j,x,p:integer;
    g:text;
procedure citire;
var f:text;
begin
assign(f,'nrtri.in'); reset(f);
read(f,n);
for i:=1 to n do read(f,v[i]);
close(f);
end;
procedure quicksort(s,d:integer);
var i,j,e,aux:integer;
begin
i:=s;
j:=d;
e:=v[(i+j)div 2];
repeat
while v[i]<e do inc(i);
while v[j]>e 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<d then quicksort(i,d);
if j>s then quicksort(s,j);
end;
function search(x:integer):integer;
var e,s,d,p:integer;
begin
search:=0;
p:=0;
s:=j;
d:=n;
while s<=d do
 begin
 e:=(s+d)div 2;
 if x=v[e] then begin search:=e; break; end
           else if x>v[e] then begin
                               search:=e+1;
                               s:=e+1;
                               end

                          else
                               begin
                               d:=e-1;
                               search:=e-1;
                               end;
 end;

end;
begin {pp}
citire;
quicksort(1,n);
for i:=1 to n-2 do
 for j:=i+1 to n-1 do
 begin
 p:=search(v[i]+v[j]);
 if p<>0 then x:=x+(j-p+1);
 end;
assign(g,'nrtri.out');rewrite(g);
write(g,x);
close(g);
end.