Cod sursa(job #31568)

Utilizator fogabFodor Gabor fogab Data 16 martie 2007 11:36:26
Problema Triang Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.6 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:=i;
      k2:=j;
      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 abs(a[k1,2]-fy)<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
          if k1>j then break;
        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:=i;
      k2:=j;
      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 abs(a[k1,2]-fy)<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
          if k1>j then break;
        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:=i;
      k2:=j;
      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);
      if k1>j then break;
      while abs(a[k1,1]-fx)<=0.001 do
        begin
          if abs(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:=i;
      k2:=j;
      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 abs(a[k1,2]-fy)<=0.001 then begin
                                    inc(sol);
                                    break;
                                    end;
          inc(k1);
          if k1>j then break;
        end;
    end;
assign(f,'triang.out');
rewrite(f);
writeln(f,sol);
close(f);
end.