Cod sursa(job #268657)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 1 martie 2009 17:02:05
Problema Trapez Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.78 kb
program alex;
type vector=array[1..1000005]of longint;
var f:text;
    x,y:array[1..1005]of longint;
    s,s1:vector;
    a,b,i,n,k,z,d,c,poz,q,c1,r:longint;
    t,u,nr:int64;
    e:boolean;
procedure poz1(li,ls:longint; var k:longint; var s,s1:vector);
var i,j,c,i1,j1:longint;
    t,u:int64;
begin
i1:=0;
j1:=-1;
i:=li;
j:=ls;
while i<j do
      begin
      t:=(s[i]*s1[i+1]-s1[i]*s[i+1]);
      u:=(s1[i]*s1[i+1]);
      if((t>0)and(u>0))or((t<0)and(u<0))then begin
                                             c:=s[i];
                                             s[i]:=s[i+1];
                                             s[i+1]:=c;
                                             c:=s1[i];
                                             s1[i]:=s1[i+1];
                                             s1[i+1]:=c;
                                             c:=i1;
                                             i1:=-j1;
                                             j1:=-c;
                                             end;
      i:=i+i1;
      j:=j+j1;
      end;
k:=i;
end;
procedure quick(li,ls:longint);
begin
if li<ls then begin
              poz1(li,ls,k,s,s1);
              quick(li,k-1);
              quick(k+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);
nr:=0;
k:=0;
d:=0;q:=0;
for a:=1 to n-1 do
    for b:=a+1 to n do
        begin
        e:=false;
        if y[b]-y[a]=0 then begin
                            e:=true;
                            d:=d+1;
                            end;
        if x[b]-x[a]=0 then begin
                            q:=q+1;
                            e:=true;
                            end;

        if e=false then begin
                        z:=z+1;
                        s[z]:=(y[b]-y[a]);
                        s1[z]:=(x[b]-x[a]);
                        c:=abs(s[z]);
                        c1:=abs(s1[z]);
                        r:=c mod c1;
                        while r<>0 do
                              begin
                              c:=c1;
                              c1:=r;
                              r:=c mod c1;
                              end;
                        s[z]:=s[z] div c1;
                        s1[z]:=s1[z] div c1;
                        end;
        end;
nr:=nr+(d*(d-1)) div 2;
nr:=nr+(q*(q-1)) div 2;
quick(1,z);
d:=0;
poz:=1;
for i:=1 to z-1 do
    begin
    t:=s[i]*s1[i+1];
    u:=s1[i]*s[i+1];
    if t<>u then begin
                 d:=i-poz+1;
                 poz:=i+1;
                 nr:=nr+(d*(d-1))div 2;
                 end;
    end;
d:=z-poz+1;
nr:=nr+(d*(d-1))div 2;
assign(f,'trapez.out');rewrite(f);
writeln(f,nr);
close(f);
end.