Cod sursa(job #17514)

Utilizator hitmannCiocas Radu hitmann Data 16 februarie 2007 01:47:12
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.06 kb
program triunghiuri;
var st:array[1..3]of longint;
    v:array[1..800]of longint;
    i,j,n,k,c:integer;
    as,ev:boolean;
procedure sort(s,d:integer);
var i,j,aux,e:integer;
begin
i:=s;
j:=d;
e:=v[(s+d)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 s<j then sort(s,j);
  if d>i then sort(i,d);
  end;
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 afis;
var f:text;
begin
assign(f,'nrtri.out');
rewrite(f);
write(f,c);
close(f);
end;
begin {pp};
citire;
sort(1,n);
c:=0;
i:=v[1];
j:=v[2];
repeat
k:=n;
if v[i]+v[j]>=v[k] then c:=k-j+1
                   else begin
                        while (v[i]+v[j]<v[k])and(k>j) do dec(k);
                        if k>j then c:=k-j+n;
                        end;
inc(i); inc(j);
until c<>0;

afis;
end.