Cod sursa(job #1105725)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 12 februarie 2014 00:05:13
Problema Numarare triunghiuri Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
program nrtri;
   var n,i,k,j,ans:longint;
       a:array[0..1000] of longint;
{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
        for k:=j+1 to n do
          if a[i]+a[j]>=a[k] then
                        inc(ans);
      write(ans);
   close(output);
end.