Cod sursa(job #206074)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 4 septembrie 2008 14:47:41
Problema Triang Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.02 kb
var x,y,a,b:array[0..1510]of double;
    n,i,j,k,c1,c2,c3,nr:longint;
    x3,y3,x4,y4,u3,u4,v3,v4,d,c,s:double;
    f:text;
{procedure merge1(p,r:longint);
var q,e,f,g:longint;
begin
   q:=(p+r)div 2;
   if p<q then merge1(p,q);
   if q+1<r then merge1(q+1,r);
   for i:=p to r do
   begin
   a[i]:=x[i];
   b[i]:=y[i];
   end;
   e:=p;
   f:=q+1;
   g:=p;
   while(e<=q)and(f<=r)do
   if(b[e]<=b[f])then begin y[g]:=b[e];
                            x[g]:=a[e];
                            g:=g+1;
                            e:=e+1;
                      end
                 else begin y[g]:=b[f];
                            x[g]:=a[f];
                            g:=g+1;
                            f:=f+1;
                      end;
   while(e<=q)do
   begin
   y[g]:=b[e];
   x[g]:=a[e];
   g:=g+1;
   e:=e+1;
   end;
   while(f<=r)do
   begin
   y[g]:=b[f];
   x[g]:=a[f];
   g:=g+1;
   f:=f+1;
   end;
end; }
procedure merge2(p,r:longint);
var q,e,f,g:longint;
begin
   q:=(p+r)div 2;
   if p<q then merge2(p,q);
   if q+1<r then merge2(q+1,r);
   for i:=p to r do
   begin
   a[i]:=x[i];
   b[i]:=y[i];
   end;
   e:=p;
   f:=q+1;
   g:=p;
   while(e<=q)and(f<=r)do
   if(a[e]<=a[f])then begin y[g]:=b[e];
                            x[g]:=a[e];
                            g:=g+1;
                            e:=e+1;
                      end
                 else begin y[g]:=b[f];
                            x[g]:=a[f];
                            g:=g+1;
                            f:=f+1;
                      end;
   while(e<=q)do
   begin
   y[g]:=b[e];
   x[g]:=a[e];
   g:=g+1;
   e:=e+1;
   end;
   while(f<=r)do
   begin
   y[g]:=b[f];
   x[g]:=a[f];
   g:=g+1;
   f:=f+1;
   end;
end;
function max(a,b:double):boolean;
var c,d:longint;
begin
   c:=trunc(a*1000);
   d:=trunc(b*1000);
   if c-d>=-1 then max:=true
             else max:=false;
end;
function egal(a,b:double):boolean;
var c,d:longint;
begin
   c:=trunc(a*1000);
   d:=trunc(b*1000);
   if abs(c-d)<=1 then egal:=true
                  else egal:=false;
end;
begin
   assign(f,'triang.in');
   reset(f);
   read(f,n);
   for i:=1 to n do
   read(f,x[i],y[i]);
   close(f);
 {  merge1(1,n); }
   merge2(1,n);
   for i:=1 to n-2 do
   for j:=i+1 to n-1 do
   begin
   d:=sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]));
   u3:=d/2;
   v3:=d*sqrt(3)/2;
   u4:=d/2;
   v4:=-(d*sqrt(3)/2);
   s:=(y[j]-y[i])/d;
   c:=(x[j]-x[i])/d;
   x3:=x[i]+c*u3-s*v3;
   y3:=y[i]+s*u3+c*v3;
   x4:=x[i]+c*u4-s*v4;
   y4:=y[i]+s*u4+c*v4;
   c1:=j+1;
   c2:=n;
   if x4>x3 then begin x3:=x4;
                       y3:=y4;
                 end;
   if x3>x[c1]-1 then begin
   while(c1<c2)do
   begin
   c3:=(c1+c2)div 2;
   if max(x[c3],x3) then c2:=c3
                    else c1:=c3+1;
   end;
   while(egal(x3,x[c1]))and(c1<=n)do
   begin
   if egal(y3,y[c1]) then nr:=nr+1;
   c1:=c1+1;
   end;
   end;
   end;
   assign(f,'triang.out');
   rewrite(f);
   writeln(f,nr);
   close(f);
end.