PRAVO - Tam giác vuông

Tác giả: ll931110

Ngôn ngữ: Pascal

{$inline on}
{$N+}
program PRAVO;
const
  input  = '';
  output = '';
  maxn = 1500;
  eps = 1e-13;
var
  a,b,t: array[1..maxn] of longint;
  q,s: array[1..maxn] of extended;
  nb,cc: longint;
  n: longint;
  time: longint;
  res: longint;

procedure init;inline;
var
  f: text;
  i: longint;
begin
  assign(f, input);
    reset(f);

  readln(f, n);
  for i := 1 to n do readln(f, a[i], b[i]);

  close(f);
end;

procedure sort(l,h: longint);inline;
var
  i,j: longint;
  p,tmp: extended;
begin
  if l >= h then exit;
  i := l;  j := h;  p := s[random(h - l + 1) + l];

  repeat
    while s[i] < p do inc(i);
    while s[j] > p do dec(j);
    if i <= j then
      begin
        if i < j then
          begin
            tmp := s[i];  s[i] := s[j];  s[j] := tmp;
          end;
        inc(i);
        dec(j);
      end;
  until i > j;

  sort(l,j);  sort(i,h);
end;

procedure press;inline;
var
  i: longint;
begin
  nb := 0;
  if cc = 0 then exit;

  inc(nb);
  q[1] := s[1];  t[1] := 1;

  for i := 2 to cc do
    if s[i] > s[i - 1] then
      begin
        inc(nb);
        q[nb] := s[i];
        t[nb] := 1;
      end
    else inc(t[nb]);
end;

function equ(x,y: extended): boolean;inline;
begin
  equ := abs(x - y) < eps;
end;

function find(i: longint): longint;inline;
var
  inf,sup,med: longint;
  x: extended;
begin
  inf := i + 1;  sup := nb;
  x := -1/q[i];
  repeat
    med := (inf + sup) div 2;
    if equ(q[med],x) then exit(t[med])
    else if q[med] > x then sup := med - 1
    else inf := med + 1;
  until inf > sup;

  find := 0;
end;

procedure calc(x: longint);inline;
var
  i,n0,ninf: longint;
begin
  cc := 0;
  n0 := 0;
  ninf := 0;

  for i := 1 to n do if i <> x then
    if b[i] = b[x] then inc(ninf)
    else if a[i] = a[x] then inc(n0)
    else
      begin
        inc(cc);
        s[cc] := (b[i] - b[x]) / (a[i] - a[x]);
      end;

  if cc = 0 then exit;
  sort(1,cc);
  press;

  for i := 1 to nb - 1 do
    res := res + t[i] * find(i);
  res := res + n0 * ninf;
end;

procedure solve;inline;
var
  i: longint;
begin
  res := 0;
  for i := 1 to n do calc(i);
end;

procedure printresult;inline;
var
  f: text;
begin
  assign(f, output);
    rewrite(f);
    writeln(f, res);
  close(f);
end;

begin
  init;
  solve;
  printresult;
end.

Download