Cod sursa(job #21942)

Utilizator ScrazyRobert Szasz Scrazy Data 25 februarie 2007 10:56:50
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.1 kb
Var
     db:longint;
     i,j,a,b,c,k,seged:word;
     n:word;
     et:array[-1..801] of 0..30000;
     f:text;
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;

function min(a,b,e,u,c:integer):integer;
begin
if a>=b then if b>=c then min:=u
          else if a>=c then min:=e
          else min:=0;
if b>a then if a>=c then min:=e
          else if b>=c then min:=u
          else min:=0;
end;
function binker(e,u:integer):integer;
var k,x:integer;
 jo:boolean;
begin
    if e>u then binker:=0
    else begin
    k:=(e+u) div 2;
    c:=a-b;
    jo:=true;

    if (e=u) or (u-e=1) then begin jo:=false;x:=min(et[e],et[u],e,u,c);binker:=x;exit;end;

     if (e<>u)and(u-e<>1) then
        if et[k]>c then if et[k-1]>=c then begin binker:=binker(e,k-1);jo:=false;end
        else if et[k]=c then begin binker:=k;exit;jo:=false;end;
     if (e<>u)and(u-e<>1) and (et[k]<c) then if et[k+1]>=c then begin binker:=binker(k+1,u);jo:=false;end
        else begin binker:=k;exit;jo:=false;end;
    if jo then begin binker:=k;exit;end;

    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);
{for i:=1 to n+1 do
 et[i]:=et[i+1];   }

{for i:=1 to n-1 do
 for j:=i+1 to n do
  if et[i]>et[j] then begin seged:=et[i];
                          et[i]:=et[j];
                          et[j]:=seged;
  end;    }
db:=0;
i:=n;
while i>2 do begin
  a:=et[i];
  j:=i-1;
  while j>1 do begin
    b:=et[j];
    k:=binker(1,j-1);
    if k<>0 then db:=db+(j-k);
    j:=j-1;
  end;
i:=i-1;
end;
assign(f,'nrtri.out');
rewrite(f);
writeln(f,db);
close(f)
end.