Cod sursa(job #189935)

Utilizator AndreiDDiaconeasa Andrei AndreiD Data 19 mai 2008 12:55:56
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
var a:array[1..1000] of integer;
i,j,n,k,m,l,aux,nr,ls,ld:longint;
f:text;
ok:boolean;   
procedure citire;
var i:longint;
begin
for i:=1 to n do  
read(f,a[i]);   
end;   
begin
assign(f,'nrtri.in');reset(f);   
readln(f,n);   
nr:=0;   
citire;
close(f);   
repeat
ok:=true;
for i:=1 to n-1 do
    if a[i]>a[i+1] then begin
    ok:=false;
    aux:=a[i];
    a[i]:=a[i+1];
    a[i+1]:=aux;
    end;
    until ok;
for i:=1 to n-1 do
for j:=1 to n do begin
ls:=j;
ld:=n;  
m:=(ls+ld) div 2;  
ok:=false;  
while ls<=ld do begin  
if ((a[m]<=a[i]+a[j]) and (a[m+1]>a[i]+a[j])) or ((a[m]<=a[i]+a[j]) and (m=n)) then break
     else if (a[m]<=a[i]+a[j]) and (a[m+1]<=a[i]+a[j]) then begin  
     ls:=m+1;
     m:=(ls+ld) div 2;  
     end  
     else begin  
     ld:=m-1;  
     m:=(ls+ld) div 2;  
     end;  
end;  
end;
assign(f,'nrtri.out');rewrite(f);
write(f,m);
close(f);   
end.