Cod sursa(job #1105686)

Utilizator Vasile_Catananoname Vasile_Catana Data 11 februarie 2014 23:33:48
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
program pdas1;
var a:array[0..801] of integer;
    f,g:text;
    i,n,j,k,u,aux,sol,poz,t:longint;
    b1,b2:array[0..1 shl 17 ] of char;
    p1:boolean;


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;
procedure cautbin(x,i,j:longint);
var mijl:integer;
begin
        while (i<j) do begin
                mijl:=(i+j) div 2;
                if (a[mijl]<=x) then i:=mijl+1
                        else j:=mijl;
                       end;
        mijl:=(i+j) div 2;
        if (a[mijl]>x) then dec(mijl);
poz:=mijl;
end;
begin
assign(f,'nrtri.in');settextbuf(g,b1);reset(F);
assign(g,'nrtri.out');settextbuf(g,b2);rewrite(G);
readln(f,n);
for i:=1 to n do
                read(f,a[i]);
sort(1,n);
for t:=1 to n-2 do
        for k:=t+1 to n-1 do
                begin
                u:=a[t]+a[k];
                cautbin(u,k+1,n);
                if a[poz]<=u then sol:=sol+(poz-k);
                end;
writeln(g,sol);
close(F);
close(G);
end.