Cod sursa(job #480320)

Utilizator danalex97Dan H Alexandru danalex97 Data 27 august 2010 14:17:06
Problema Numarare triunghiuri Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
program nrtri;
type sir=array[1..801] of longint;
var a:sir;
    n,i,st,dr,j:integer;
    c:longint;
    f,g:text;

function pozitionare(st,dr:integer):integer;
var xst,xdr,aux:integer;
begin
  xst:=0;
  xdr:=-1;
  while st<dr do
    if a[st]<a[dr] then
      begin
        st:=st+xst;
        dr:=dr+xdr;
      end
    else
      begin
        aux:=a[st];
        a[st]:=a[dr];
        a[dr]:=aux;
        xst:=1-xst;
        xdr:=-1-xdr;
        st:=st+xst;
        dr:=dr+xdr;
      end;
  pozitionare:=st;
end;

procedure quick(st,dr:integer);
var p:integer;
begin
  p:=pozitionare(st,dr);
  if st<p-1 then quick(st,p-1);
  if p+1<dr then quick(p+1,dr);
end;

begin
  c:=0;
  assign(f,'nrtri.in');reset(f);
  assign(g,'nrtri.out');rewrite(g);
  readln(f,n);
  for i:=1 to n do read(f,a[i]);
  quick(1,n);
  a[n+1]:=1000000;
  for i:=1 to n-2 do
    for j:=i+1 to n-1 do
      begin
        for st:=j to n+1 do
          if a[i]+a[j]<a[st] then break;
        inc(c,st-j-1);
      end;
  writeln(g,c);
  close(f);
  close(g);
end.