Cod sursa(job #330043)

Utilizator ionutz32Ilie Ionut ionutz32 Data 8 iulie 2009 15:12:28
Problema Triang Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.38 kb
{$N+}
var x,y:array[1..1500] of double;
n,i,j,t,p,u,m,nr:longint;
aux,c,d,diag1,diag2,c2,d2,a,b,latmare,latmica:double;
f,g:text;
k:boolean;
function aprox(x:double):double;
         begin
         aprox:=trunc(x*1000);
         end;
begin
assign(f,'triang.in');
assign(g,'triang.out');
reset(f);rewrite(g);
readln(f,n);
for i:=1 to n do
    readln(f,x[i],y[i]);
t:=n;
repeat
      k:=true;
      for i:=1 to t-1 do
          if (x[i]>x[i+1]) or ((x[i]=x[i+1]) and (y[i]>y[i+1])) then
             begin
             aux:=x[i];
             x[i]:=x[i+1];
             x[i+1]:=aux;
             aux:=y[i];
             y[i]:=y[i+1];
             y[i+1]:=aux;
             k:=false;
             end;
      t:=t-1;
until k=true;
for i:=1 to n-1 do
    for j:=i+1 to n do
        begin
        c:=abs(x[j]-x[i]);
        d:=abs(y[j]-y[i]);
        diag2:=sqrt(c*c+d*d);
        diag1:=diag2*sqrt(3)/2;
        diag2:=diag2/2;
        c2:=(x[i]+x[j])/2;
        d2:=(y[i]+y[j])/2;
        d:=abs(c2-x[i]);
        c:=abs(d2-y[i]);
        latmare:=c*diag1/diag2;
        latmica:=d*diag1/diag2;
        if ((x[j]>x[i]) and (y[j]>y[i])) or ((x[i]>x[j]) and (y[i]>y[j])) then
           begin
           a:=c2-latmare;
           b:=d2+latmica;
           c2:=c2+latmare;
           d2:=d2-latmica;
           end
        else
            begin
            a:=c2+latmare;
            b:=d2+latmica;
            c2:=c2-latmare;
            d2:=d2-latmica;
            end;
        p:=j+1;u:=n;
        while p<=u do
              begin
              m:=(p+u) div 2;
              c:=aprox(x[m]);
              d:=aprox(a);
              if (c-d>1) or ((abs(c-d)<=1) and (aprox(y[m])-aprox(b)>=1)) then
                 u:=m-1
              else
                  p:=m+1;
              end;
        if (abs(aprox(x[u+1])-d)<=1) and (abs(aprox(y[u+1])-aprox(b))<=1) then
           nr:=nr+1;
        p:=j+1;u:=n;
        while p<=u do
              begin
              m:=(p+u) div 2;
              c:=aprox(x[m]);
              d:=aprox(c2);
              if (c-d>1) or ((abs(c-d)<=1) and (aprox(y[m])-aprox(d2)>=1)) then
                 u:=m-1
              else
                  p:=m+1;
              end;
        if (abs(aprox(x[u+1])-d)<=1) and (abs(aprox(y[u+1])-aprox(d2))<=1) then
           nr:=nr+1;
        end;
write(g,nr);
close(f);close(g);
end.