Cod sursa(job #248634)

Utilizator qSortMorariu Razvan qSort Data 26 ianuarie 2009 12:45:47
Problema Trapez Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.64 kb
program trapez;
type casuta=record
						x,y:int64;
						end;
		vector=array[1..60000] of casuta;
var a:array[1..1000] of casuta;
		b:vector;
		n,i,j,k,trap:longint;
		oX,oY:int64;
		aux:casuta;
		f,g:text;
		ok:boolean;

procedure qsort(var v:vector; p,t:integer);
var st,dr:longint;
		m,aux:casuta;
begin
st:=p;
dr:=t;
m:=v[(p+t) div 2];
repeat
	while v[st].y*m.x<v[st].x*m.y do st:=st+1;
	while v[dr].y*m.x>v[dr].x*m.y do dr:=dr-1;
		if st<=dr then begin
										aux:=v[st];
										v[st]:=v[dr];
										v[dr]:=aux;
										st:=st+1;
										dr:=dr-1;
									 end;
until st>dr;
if p<dr then qsort(v,p,dr);
if st>t then qsort(v,st,t);

end;




begin
assign(f,'trapez.in'); reset(f);
assign(g,'trapez.out'); rewrite(g);
read(f,n);
k:=0;
for i:=1 to n do
	read(f,a[i].x,a[i].y);
for i:=1 to n-1 do
	for j:=i+1 to n do
		begin
		oX:=a[i].x-a[j].x;
		oY:=a[i].y-a[j].y;
		if (oX<>0) then  begin
											k:=k+1;

											if oX<0 then  begin b[k].y:=-1*oY; b[k].x:=-1*oX; end else
												begin
												b[k].y:=oY;
												b[k].x:=oX;
												end;
											end;
		end;
i:=1;
{repeat
	ok:=true;
	for i:=1 to k-1 do
		if b[i].y*b[i+1].x>b[i].x*b[i+1].y then
					begin
					aux:=b[i];
					b[i]:=b[i+1];
					b[i+1]:=aux;
					ok:=false;
					end;
until ok;}
qsort(b,1,k);

i:=1;
j:=1;
while i<k do
	begin
		if b[i].y*b[i+1].x=b[i].x*b[i+1].y then
			while (b[i].y*b[i+1].x=b[i].x*b[i+1].y) and (i<k) do
				begin
					j:=j+1;
					i:=i+1;
				end;
	if j<>1 then trap:=trap+(j*(j-1) div 2);
	j:=1;
	i:=i+1;
	end;

write(g,trap);
close(f);
close(g);
end.