Cod sursa(job #267197)

Utilizator MihaiBunBunget Mihai MihaiBun Data 26 februarie 2009 21:25:11
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.63 kb
program nrt;
type vector=array[1..800] of longint;
var f:text;
    i,j,k,n,nr,l1,l2,mij,m:longint;
    a:vector;

procedure poz(li,ls:longint;var k:longint;var a:vector);
var p,q,c,p1,q1:longint;
begin
   p1:=0;
   q1:=-1;
   p:=li;
   q:=ls;
   while p<q do
     begin
       if a[p]>a[q]  then begin
                            c:=a[p];
                            a[p]:=a[q];
                            a[q]:=c;
                            c:=p1;
                            p1:=-q1;
                            q1:=-c
                          end;
       p:=p+p1;
       q:=q+q1;
     end;
    k:=p;
  end;

  procedure quick(li,ls:longint);
  begin
    if li<ls then begin
                     poz(li,ls,k,a);
                     quick(li,k-1);
                     quick(k+1,ls)
                  end;
  end;
begin
  assign(f,'nrtri.in');
  reset(f);
  readln(f,n);
  for i:=1 to n do read(f,a[i]);
  close(f);
  assign(f,'nrtri.out');
  rewrite(f);
  nr:=0;
  quick(1,n);
  for i:=1 to n-2 do
    for j:=i+1 to n-1 do
      begin
       l1:=j+1;
       l2:=n;
       while l1<=l2 do
         begin
           mij:=(l1+l2)div 2;
           if a[i]+a[j]<a[mij] then l2:=mij-1
                               else l1:=mij+1
         end;
       if a[i]+a[j]<a[mij] then while a[i]+a[j]<a[mij] do mij:=mij-1
                           else begin
                                 while (a[i]+a[j]<=a[mij])and(mij<n) do mij:=mij+1;
                                 if a[i]+a[j]<a[mij] then mij:=mij-1
                                end;
       nr:=nr+mij-j
      end;
  writeln(f,nr);
  close(f);
end.