Cod sursa(job #973847)

Utilizator t.g.g.tt.g.g.t t.g.g.t Data 15 iulie 2013 19:21:34
Problema Trapez Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.56 kb
var a:array[1..2,1..1000]of longint;
    b:array[1..2,1..500000]of int64;
    i,n,j,v,p1,p2:longint;
    v2,rs:int64;
    buf:array[1..1 shl 10]of char;

procedure qsort(st,dr:longint);
  var i,j,t:longint; m:int64; bl:boolean;
  begin
    i:=st; j:=dr; m:=(i+j)div 2;
    repeat
      bl:=true;
      while bl do begin if b[2,i]*b[2,m]<0 then t:=-1 else t:=1; if b[1,i]*b[2,m]*t<b[1,m]*b[2,i]*t then inc(i) else bl:=false end;
      bl:=true;
      while bl do begin if b[2,j]*b[2,m]<0 then t:=-1 else t:=1; if b[1,j]*b[2,m]*t>b[1,m]*b[2,j]*t then dec(j) else bl:=false end;
      if i<=j then begin t:=b[1,i]; b[1,i]:=b[1,j]; b[1,j]:=t; t:=b[2,i]; b[2,i]:=b[2,j]; b[2,j]:=t; inc(i); dec(j); end;
    until i>j;
    if st<j then qsort(st,j);
    if i<dr then qsort(i,dr);
  end;

begin
  assign(input,'trapez.in'); reset(input);
  readln(n);
  for i:=1 to n do readln(a[1,i],a[2,i]);
  v:=0;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      begin
        if (a[2,i]-a[2,j]<>0) and (a[1,i]-a[1,j]<>0) then
          begin
            inc(v);
            b[1,v]:=a[2,i]-a[2,j];
            b[2,v]:=a[1,i]-a[1,j];
          end
        else
          begin
            if a[2,i]-a[2,j]<>0 then inc(p1)
            else if a[1,i]-a[1,j]<>0 then inc(p2);
          end;
      end;
  qsort(1,v); v2:=0;
  for i:=2 to v do begin if b[1,i]*b[2,i-1]=b[1,i-1]*b[2,i] then inc(v2) else v2:=0; rs:=rs+v2*(v2-1)div 2; end;
  rs:=rs+(p1*(p1-1)div 2);
  rs:=rs+(p2*(p2-1)div 2);
  assign(output,'trapez.out'); rewrite(output);
  writeln(rs);
  close(output);
end.