Cod sursa(job #332156)

Utilizator ionutz32Ilie Ionut ionutz32 Data 16 iulie 2009 21:27:32
Problema Triang Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.21 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,piv,piv2: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;
function sort2(min,max:longint):longint;
         begin
         piv:=x[min+(max-min) div 2];
         piv2:=y[min+(max-min) div 2];
         i:=min-1;
         j:=max+1;
         k:=true;
         repeat
               repeat
                     i:=i+1;
               until (x[i]>piv) or ((x[i]=piv) and (y[i]>=piv2));
               repeat
                     j:=j-1;
               until (x[j]<piv) or ((x[j]=piv) and (y[j]<=piv2));
               if i<j then
                  begin
                  aux:=x[i];
                  x[i]:=x[j];
                  x[j]:=aux;
                  aux:=y[i];
                  y[i]:=y[j];
                  y[j]:=aux;
                  end
               else
                   begin
                   k:=false;
                   sort2:=j;
                   break;
                   end;
         until k=false;
         end;
procedure sort(min,max:longint);
          var p:longint;
          begin
          if min<max then
             begin
             p:=sort2(min,max);
             sort(min,p);
             sort(p+1,max);
             end;
          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]);
sort(1,n);
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.