Cod sursa(job #237769)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 30 decembrie 2008 18:25:44
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.22 kb
program alex;
var f:text;
    a:array[1..850]of integer;
    i,j,h,d,n,k,z,s,x,m:longint;
    e:boolean;
begin
assign(f,'nrtri.in');reset(f);
readln(f,n);
for i:=1 to n do
    read(f,a[i]);
close(f);
k:=1;
e:=true;
while e=true do
      begin
      e:=false;
      for i:=1 to n-k do
          if a[i]>a[i+1] then begin
                              z:=a[i];
                              a[i]:=a[i+1];
                              a[i+1]:=z;
                              e:=true;
                              end;
      k:=k+1;
      end;
d:=0;
for i:=1 to n-2 do
    for j:=i+1 to n-1 do
        begin
        s:=a[i]+a[j];
        x:=j+1;
        z:=n;
        m:=(x+z) div 2;
        e:=false;
        while x<=z do
              begin
              e:=true;
              if s>=a[m] then begin
                              x:=m+1;
                              m:=(x+z) div 2;
                              end
                         else begin
                              z:=m-1;
                              m:=(x+z)div 2;
                              end;
              end;
        if(e=true)then d:=d+(m-j);
        end;
assign(f,'nrtri.out');rewrite(f);
writeln(f,d);
close(f);
end.