Cod sursa(job #600)

Utilizator kimhioCobarzan Petrut kimhio Data 11 decembrie 2006 16:14:16
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.84 kb
program hio;
uses crt;
type ta=array [0..801] of integer;
var a:ta;
    n,i,j,aux:integer;
    f:text;
    ok:boolean;
    std,drd,sts,q,drs,nrtot,sum,dif,tl:longint;
begin    {pp}
clrscr;
assign(f,'nrtri.in');reset(f);
readln(f,n);
for i:=1 to n do
    read(f,a[i]);
close(f);
repeat
ok:=true;
for i:=1 to n-1 do
    if a[i]>a[i+1] then
       begin
       aux:=a[i];
       a[i]:=a[i+1];
       a[i+1]:=aux;
       ok:=false;
       end;
until ok;
a[0]:=-1;
n:=n+1;
a[n]:=a[n-1]+a[n-2]+1;
nrtot:=0;
for i:=1 to n-1 do
    for j:=i+1 to n-1 do
        begin
        {if i<>j then
        begin}
        sum:=a[i]+a[j];
        {dif:=abs(a[j]-a[i]);
        std:=0;
        drd:=n;
        while std<drd do
              begin
              q:=(drd+std) div 2;
              if a[q]=dif then
                 begin
                 drd:=q;
                 break;
                 end;
              if a[q]<dif then std:=q+1
                          else drd:=q;
              end;}
        sts:=0;
        drs:=n;
        while sts<drs do
              begin
              q:=(drs+sts) div 2;
              if a[q]=sum then
                 begin
                 drs:=q;
                 break;
                 end;
              if a[q]<sum then sts:=q+1
                          else drs:=q;
              end;
        {if a[drd]=dif then
           begin
           while a[drd-1]=dif do
                 drd:=drd-1;
           end;}
        if a[drs]=sum then
           begin
           while a[drs]=sum do
                 drs:=drs+1;
           end;
        tl:=drs-j-1;
        if tl>0 then
           begin
           nrtot:=nrtot+tl;
           {writeln(i,' ',j,' ',tl);}
           end;
        {end;}
        end;
assign(f,'nrtri.out');rewrite(f);
write(f,nrtot);
close(f);
end.