Cod sursa(job #31049)

Utilizator fogabFodor Gabor fogab Data 15 martie 2007 13:57:05
Problema Triang Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.47 kb
var f:text;
    a:array[0..1501,1..2] of double;
    i,n,j,k1,k2,sol:integer;
    fx,fy,me:double;

procedure quicksort(l,r:word);
var i,j:word;
    x:double;
begin
 i:=l;j:=r;x:=a[(l+r) div 2,1];
 repeat
   while a[i,1]<x do i:=i+1;
   while x<a[j,1] do j:=j-1;
   if i<=j then begin
                a[0]:=a[i];
                a[i]:=a[j];
                a[j]:=a[0];
                i:=i+1;
                j:=j-1;
                end;
 until i>j;
 if l<j then quicksort(l,j);
 if i<r then quicksort(i,r);
end;

begin
assign(f,'triang.in');
reset(f);
readln(f,n);
for i:=1 to n do
 read(f,a[i,1],a[i,2]);
close(f);
quicksort(1,n);
me:=sqrt(3)/2;
a[0,1]:=-10001;
a[0,1]:=-10001;
a[n+1,2]:=10001;
a[n+1,2]:=10001;
for i:=1 to n-1 do
  for j:=i+1 to n do
    if a[i,2]<=a[j,2] then begin
      fx:=a[i,1]+((a[j,1]-a[i,1])/2)+(a[j,2]-a[i,2])*me;
      fy:=a[i,2]+((a[j,2]-a[i,2])/2)-(a[j,1]-a[i,1])*me;
      k1:=0;
      k2:=n+1;
      while k2-k1>1 do
        begin
          if abs(a[(k1+k2) div 2,1]-fx)<=0.001 then k2:=(k1+k2) div 2
             else if fx>a[(k1+k2) div 2,1] then k1:=(k1+k2) div 2
             else k2:=(k1+k2) div 2;
        end;
      inc(k1);
      while abs(a[k1,1]-fx)<=0.001 do
        begin
          if a[k1,2]-fy<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
        end;
      fx:=a[i,1]+((a[j,1]-a[i,1])/2)-(a[j,2]-a[i,2])*me;
      fy:=a[i,2]+((a[j,2]-a[i,2])/2)+(a[j,1]-a[i,1])*me;
      k1:=0;
      k2:=n+1;
      while k2-k1>1 do
        begin
          if abs(a[(k1+k2) div 2,1]-fx)<=0.001 then k2:=(k1+k2) div 2
             else if fx>a[(k1+k2) div 2,1] then k1:=(k1+k2) div 2
             else k2:=(k1+k2) div 2;
        end;
      inc(k1);
      while abs(a[k1,1]-fx)<=0.001 do
        begin
          if a[k1,2]-fy<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
        end;
    end else begin
      fx:=a[i,1]+((a[j,1]-a[i,1])/2)+(a[i,2]-a[j,2])*me;
      fy:=a[i,2]+((a[j,2]-a[i,2])/2)+(a[j,1]-a[i,1])*me;
      k1:=0;
      k2:=n+1;
      while k2-k1>1 do
        begin
          if abs(a[(k1+k2) div 2,1]-fx)<=0.001 then k2:=(k1+k2) div 2
             else if fx>a[(k1+k2) div 2,1] then k1:=(k1+k2) div 2
             else k2:=(k1+k2) div 2;
        end;
      inc(k1);
      while abs(a[k1,1]-fx)<=0.001 do
        begin
          if a[k1,2]-fy<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
        end;
      fx:=a[i,1]+((a[j,1]-a[i,1])/2)-(a[i,2]-a[j,2])*me;
      fy:=a[i,2]+((a[j,2]-a[i,2])/2)-(a[j,1]-a[i,1])*me;
      k1:=0;
      k2:=n+1;
      while k2-k1>1 do
        begin
          if abs(a[(k1+k2) div 2,1]-fx)<=0.001 then k2:=(k1+k2) div 2
             else if fx>a[(k1+k2) div 2,1] then k1:=(k1+k2) div 2
             else k2:=(k1+k2) div 2;
        end;
      inc(k1);
      while abs(a[k1,1]-fx)<=0.001 do
        begin
          if a[k1,2]-fy<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
        end;
    end;
assign(f,'triang.out');
rewrite(f);
writeln(f,sol div 3);
close(f);
end.