Cod sursa(job #227356)

Utilizator Andrei200Andrei200 Andrei200 Data 4 decembrie 2008 10:30:59
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
type list=array[1..900] of integer;   
var a:list;   
i,j,n,k,ls,ld,m:integer;   
nr:longint;   
f:text;   
ok:boolean;   
procedure citire(var a:list);   
var i:integer;   
begin  
for i:=1 to n do  
read(f,a[i]);   
end;   
procedure QuickSort(var A: List; Lo, Hi: Integer);   
procedure Sort(l,r:Integer);   
var  
  i,j,x,y:integer;   
begin  
  i:=l; j := r; x := a[(l+r) DIV 2];   
repeat  
    while a[i] < x do i := i + 1;   
    while x < a[j] do j := j - 1;   
    if i <= j then  
    begin  
      y := a[i]; a[i] := a[j]; a[j] := y;   
      i := i + 1; j := j - 1;   
    end;   
  until i > j;   
  if l < j then Sort(l, j);   
  if i < r then Sort(i, r);   
end;   
begin {QuickSort};   
  Sort(Lo,Hi);   
end;   
begin  
assign(f,'nrtri.in');reset(f);   
readln(f,n);   
nr:=0;   
citire(a);   
close(f);   
quicksort(a,1,n);   
assign(f,'nrtri.out');rewrite(f);   
ls:=1;   
ld:=n;   
m:=(ls+ld) div 2;   
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   
nr:=nr+m   
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;   
//if ok then nr:=nr+m-j;   
write(f,nr);   
close(f);   
end.