Cod sursa(job #267158)

Utilizator MihaiBunBunget Mihai MihaiBun Data 26 februarie 2009 20:15:26
Problema Trapez Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.4 kb
program trape;
type vector=array[1..500000] of longint;
var f:text;
    x,y,u,v:vector;
    i,j,n,s,kk,k,a,c,b,r,d:longint;
    sum,t,g:int64;

procedure poz(li,ls:longint;var kk:longint;var u,v:vector);
var p,q,c,p1,q1:longint;
begin
   p1:=0;
   q1:=-1;
   p:=li;
   q:=ls;
   while p<q do
     begin
       if (((v[p]*u[q]-u[p]*v[q])>0) and (u[p]*u[q]>0))or(((v[p]*u[q]-u[p]*v[q])<0) and (u[p]*u[q]<0))  then begin
                                                  c:=u[p];
                                                  u[p]:=u[q];
                                                  u[q]:=c;
                                                  c:=v[p];
                                                  v[p]:=v[q];
                                                  v[q]:=c;
                                                  c:=p1;
                                                  p1:=-q1;
                                                  q1:=-c
                                                 end;
       p:=p+p1;
       q:=q+q1;
     end;
    kk:=p;
  end;

  procedure quick(li,ls:longint);
  begin
    if li<ls then begin
                     poz(li,ls,kk,u,v);
                     quick(li,kk-1);
                     quick(kk+1,ls)
                  end;
  end;

begin
  assign(f,'trapez.in');
  reset(f);
  readln(f,n);
  for i:=1 to n do
    readln(f,x[i],y[i]);
  close(f);
  assign(f,'trapez.out');
  rewrite(f);
  k:=0;
  t:=0;
  g:=0;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      begin

        a:=x[i]-x[j];
        b:=y[i]-y[j];

        if (a<>0)and(b<>0) then
        begin
         k:=k+1;
         c:=a;
        d:=b;
        r:=a mod b;
        while r<>0 do
         begin
           a:=b;
           b:=r;
           r:=a mod b
         end;
        c:=c div b;
        d:=d div b;
        u[k]:=c;
        v[k]:=d
        end
         else if (a=0)and(b<>0) then t:=t+1
                                else if (b=0)and(a<>0) then g:=g+1;

       end;
  quick(1,k);
  s:=1;
  sum:=(t*(t-1))div 2+(g*(g-1))div 2;
  for i:=2 to k do
     if (u[i]*v[i-1]=u[i-1]*v[i]) then s:=s+1
                                      else begin
                                            sum:=sum+(s*(s-1)) div 2;
                                            s:=1
                                           end;
  writeln(f,sum);
  close(f);
  end.