Cod sursa(job #15189)

Utilizator icetTamas Radu icet Data 11 februarie 2007 01:13:32
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
 program triunghiuri;
 type vect = array[0..800] of integer;
 var a,b: vect;
     i,j,n: integer;
     s: longint;
     f: text;

 procedure quick(s,d: integer);
 var i,j,aux,e: integer;
 begin
  i:=s; j:=d; e:=a[(i+j) div 2];

  repeat

   while a[i] < e do inc(i);
   while a[j] > e do dec(j);

   if i<=j then begin
     aux := a[i];
     a[i]:=a[j];
     a[j]:=aux;
     inc(i); dec(j);
   end;

  until i>j;

   if s<j then Quick(s,j);
   if d>i then Quick(i,d);

 end;


 begin
   assign(f,'nrtri.in'); reset(f);
    readln(f,n);
    for i:=1 to n do read(f,a[i]);
   Close(f);

   Quick(1,n);
   FillChar(b,sizeof(b),0);

   for i:=1 to n-1 do
     if a[i] <> a[i-1] then  for j:=i+1 to n do
                               if a[i] + a[j] < a[n] then inc(b[i]);

   S:=0;
   for i:=1 to n do inc(s,b[i]);
   assign(f,'nrtri.out'); rewrite(f);
     write(f,s);
   Close(f);

 end.