Cod sursa(job #20383)

Utilizator ScrazyRobert Szasz Scrazy Data 21 februarie 2007 13:16:49
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.14 kb
Var
     db:longint;
     i,j,a,b,c:word;
     n:word;
     et,v:array[1..801] of 0..30000;
     f:text;
     kesz,jo:boolean;
Function szetvalogat(e,u:word):word;
var seged:integer;
begin
  seged:=et[e];
  while e<u do begin
    while (e<u) and (et[u]>=seged) do
      dec(u);
    if e<u then begin
      et[e]:=et[u];
      inc(e);
      while (e<u) and (et[e]<seged) do
        inc(e);
      et[u]:=et[e];
      dec(u);
    end;
  end;
  et[e]:=seged;
  szetvalogat:=e;
end;
procedure gyors(ah,fh:integer);
var k:integer;
begin
  if ah<fh then begin
    k:=szetvalogat(ah,fh);
    gyors(ah,k-1);
    gyors(k+1,fh);
  end;
end;

begin
Assign(f,'nrtri.in');
reset(f);
readln(f,n);
for i:=1 to n do
 read(f,et[i]);
close(f);
gyors(1,n);
c:=et[n];
i:=0;
kesz:=true;
jo:=true;
while (i<n) and kesz do begin
  i:=i+1;
  j:=i;
  jo:=true;
  while (j<n) and jo do begin
    j:=j+1;
    if et[i]+et[j]<=c then db:=db+1
                     else jo:=false;
  end;
  if j=1 then kesz:=false;
end;
assign(f,'nrtri.out');
rewrite(f);
if n mod 2=0 then writeln(f,db-1)
             else writeln(f,db);
close(f);
end.