PRAVO - Tam giác vuông

Tác giả: RR

Ngôn ngữ: Pascal

//Written by Nguyen Thanh Trung
//Finally I am able to solve this problem
{$R+,Q+,N+}
{$Mode objFPC}
uses math;
const
  FINP='';
  FOUT='';
  MAXN=1511;
  eps=1e-14;
type
  point=record x,y:double; end;
var
  f1,f2:text;
  n:longint;
  a:array[1..MAXN] of point;
  goc:array[1..MAXN] of double;
  count:array[1..MAXN] of longint;
procedure openF;
begin
  assign(f1,FINP); reset(f1);
  assign(f2,FOUT); rewrite(f2);
end;
procedure closeF;
begin
  close(f1);
  close(f2);
end;
procedure inp; inline;
var
  i:longint;
begin
  read(f1,n);
  for i:=1 to n do
    with a[i] do read(f1,x,y);
end;
procedure swapd(var a,b:double); inline;
var temp:double; begin temp:=a; a:=b; b:=temp; end;
var mid:double;
procedure sort(l,r:longint); inline;
var
  i,j:longint;
begin
  i:=l; j:=r; mid:=goc[l+random(r-l+1)];
  repeat
    while goc[i]<mid do inc(i);
    while goc[j]>mid do dec(j);
    if i<=j then
      begin
        swapd(goc[i],goc[j]);
        inc(i); dec(j);
      end;
  until i>j;
  if i<r then sort(i,r);
  if l<j then sort(l,j);
end;
procedure solve;
var
  i,ii,k,now,prev:longint;
  countx,county,sl,kq:longint;
begin
  kq:=0;
  for i:=1 to n do
    begin
      countx:=0; county:=0; sl:=0;
      for ii:=1 to n do
      if ii<>i then
        if a[i].x=a[ii].x then inc(countx)
        else if a[i].y=a[ii].y then inc(county)
        else
          begin
            inc(sl);
            goc[sl]:=arctan((a[ii].y-a[i].y)/(a[ii].x-a[i].x));
          end;
        kq+=countx*county;
        if sl<2 then continue;
        sort(1,sl);
        k:=1; count[1]:=1;
        for ii:=2 to sl do
          if goc[ii]>goc[k]+eps then
            begin
              inc(k);
              goc[k]:=goc[ii];
              count[k]:=1;
            end
          else count[k]+=1;
        sl:=k;
        prev:=0;
        for now:=1 to sl do
          begin
            while (prev<sl) and (goc[prev+1]<goc[now]-pi/2+eps) do inc(prev);
            if (prev>0) and (abs(goc[now]-goc[prev]-pi/2)<eps) then kq+=count[now]*count[prev];
          end;
    end;
  writeln(f2,kq);
end;
begin
  openF;
  inp;
  solve;
  closeF;
end.

Download