Cod sursa(job #1105736)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 12 februarie 2014 00:17:14
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.75 kb
program nrtri;
   var n,i,k,j,ans:longint;
       a:array[0..1000] of longint;

function CautB(l,r,x:longint):longint;
var poz:longint;
    i,j,m:longint ;

begin
  i:=l;
  j:=r;

  while (i<=j) do
    begin
      m:=(i+j) div 2;
      if x>=a[m] then begin poz:=m; i:=m+1 end

        else j:=m-1;
    end;
  Cautb:=poz;
end;

{procedure sort(l,r:longint);
  var i,j,m,aux:longint;
  begin

    i:=l;
    j:=r;
    m:=(i+j) div 2;

    while (i<=j) do begin
                while (a[i]<a[m]) do
                     inc(i);
                while (a[j]>a[m]) do
                      dec(j);
                if i<=j then begin
                        aux:=a[i];
                        a[i]:=a[j];
                        a[j]:=aux;
                        inc(i);
                        dec(j);
                        end;
                end;
    if i<r then sort(i,r);
    if l<j then sort(l,j);

  end; }
procedure sortare(left,right:longint);
var aux,mijloc,i,j:longint;
begin
  i:=left;
  j:=right;
  mijloc:=a[(i+j) div 2];
  repeat
    while (a[i]<mijloc) do i:=i+1;
    while (a[j]>mijloc) do j:=j-1;
    if i<=j then begin
                aux:=a[i];
                a[i]:=a[j];
                a[j]:=aux;
                inc(i);
                dec(j);
                end;
    until i>j;

  if i<right then sortare(i,right);
  if left<j then sortare(left,j);
end;
  begin
    assign(input,'nrtri.in');
    reset(input);
    assign(output,'nrtri.out');
    rewrite(output);

    readln(n);
    for i:=1 to n do
                read(a[i]);
    sortare(1,n);
    for i:=1 to n-2 do
      for j:=i+1 to n-1 do
          inc(ans,Cautb(j,n,a[i]+a[j])-j);
      write(ans);
   close(output);
end.