Cod sursa(job #227435)

Utilizator FllorynMitu Florin Danut Flloryn Data 4 decembrie 2008 16:42:05
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
program pascal;
type vector=array[1..800] of longint;
var f,g:text;
    v:vector;
    n,i,j,m,t,k:longint; nr:longint;


  procedure quicksort(s,d:integer);
  var a,b,aux,ia:integer;
  begin
     a:=s; b:=d;
     repeat
     while v[a]<v[b] do b:=b-1;
     aux:=v[a];
     v[a]:=v[b];
     v[b]:=aux;
     ia:=1; a:=a+1;
     if a<b then
          begin
           while v[a]<v[b] do a:=a+1;
           if a<>b then
             begin
              aux:=v[a];
              v[a]:=v[b];
              v[b]:=aux;
              ia:=0;
              b:=b-1;
             end;
           end;
   until a>=b;
   if s<a-ia then quicksort(s,a-ia);
   if a-ia+1<d then quicksort(a-ia+1,d);
  end;



begin
assign(f,'nrtri.in'); reset(f);
assign(g,'nrtri.out'); rewrite(g);
readln(f,n);
for i:=1 to n do read(f,v[i]);
quicksort(1,n);
nr:=0;

for i:=1 to n-1 do
   for j:=i+1 to n do
     begin
     t:=v[j]+v[i];
     for k:=j+1 to n do
     if v[k]>t then break
                    else inc(nr);
    end;

write(g,nr);
close(f);
close(g);
end.