Cod sursa(job #330119)

Utilizator ionutz32Ilie Ionut ionutz32 Data 8 iulie 2009 19:41:03
Problema Triang Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.4 kb
{$N+}
var x,y:array[1..1500] of double;
n,i,j,t,p,u,m,nr,ret:longint;
aux,c,d,diag1,diag2,c2,d2,a,b,latmare,latmica:double;
f,g:text;
k:boolean;
function comp(x,y:double):word;
         begin
         if abs(x-y)<=0.001 then
            comp:=0
         else
             if x>y then
                comp:=1
             else
                 comp:=2;
         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-2 do
    for j:=i+1 to n-1 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;
              ret:=comp(x[m],a);
              if (ret=1) or ((ret=0) and (comp(y[m],b)<2)) then
                 u:=m-1
              else
                  p:=m+1;
              end;
        if (comp(x[u+1],a)=0) and (comp(y[u+1],b)=0) then
           nr:=nr+1;
        p:=j+1;u:=n;
        while p<=u do
              begin
              m:=(p+u) div 2;
              ret:=comp(x[m],c2);
              if (ret=1) or ((ret=0) and (comp(y[m],d2)<2)) then
                 u:=m-1
              else
                  p:=m+1;
              end;
        if (comp(x[u+1],c2)=0) and (comp(y[u+1],d2)=0) then
           nr:=nr+1;
        end;
write(g,nr);
close(f);close(g);
end.