Pagini recente » Cod sursa (job #1866625) | Cod sursa (job #268657)
Cod sursa(job #268657)
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.