Pagini recente » Cod sursa (job #471289) | Cod sursa (job #55421) | Cod sursa (job #2912605) | Cod sursa (job #2048632) | Cod sursa (job #299192)
Cod sursa(job #299192)
{triang}
{$N+}
type punct=record
x,y:double;
end;
var v:array[1..1500] of punct;
n:integer;
nr:longint;
punct1,punct2:punct;
da:boolean;
procedure citire;
var f:text;
i:integer;
xu,yu:double;
begin
assign(f,'triang.in'); reset(f);
readln(f,n);
for i:=1 to n do readln(f,v[i].x,v[i].y);
close(f);
end;
function part(l,r:longint):longint;
var p,pp:double;
j,i:longint;
aux:punct;
begin
p:=v[r].x;
pp:=v[r].y;
j:=l-1;
for i:=l to r do
if (v[i].x<p) or ((v[i].x=p) and (v[i].y<=pp)) then
begin
inc(j);
aux:=v[j];
v[j]:=v[i];
v[i]:=aux;
end;
part:=j;
end;
procedure qsort(l,r:longint);
var poz:longint;
begin
poz:=part(l,r);
if l<poz-1 then qsort(l,poz-1);
if r>poz+1 then qsort(poz+1,r);
end;
procedure gaseste_punct(a1,b1,a2,b2:double);
var AB,abscisa,ordonata,difo,difa,suma,a,b,c,delta,x1,x2,y1,y2:double;
begin
punct1.x:=0;
punct1.y:=0;
punct2.x:=0;
punct2.y:=0;
AB:=sqr(a1-a2)+sqr(b1-b2);
abscisa:=sqr(a1)-sqr(a2);
ordonata:=sqr(b1)-sqr(b2);
difo:=b1-b2;
difa:=a1-a2;
da:=true;
if (difo<>0) and (difa<>0) then
begin
suma:=abscisa+ordonata;
a:=4*sqr(difo)+4*sqr(difo);
b:=-4*difo*suma+8*a1*difa*difo-2*b1*sqr(difa);
c:=sqr(suma)+4*sqr(difa)*sqr(a1)-4*a1*difa*suma+4*sqr(difa)*sqr(b1)-AB*4*sqr(difa);
delta:=sqr(b)-4*a*c;
if delta>=0 then
begin
y1:=(-b+sqrt(delta))/(2*a);
y2:=(-b-sqrt(delta))/(2*a);
x1:=(abscisa+ordonata-2*y1*difo)/(2*difa);
x2:=(abscisa+ordonata-2*y2*difo)/(2*difa);
punct1.x:=round(x1*1000)/1000;
punct1.y:=round(y1*1000)/1000;
punct2.x:=round(x2*1000)/1000;
punct2.y:=round(y2*1000)/1000;
end
else da:=false;
end
else if difa=0 then
begin
y1:=ordonata/(2*difo);
punct1.y:=round(y1*1000)/1000;
punct2.y:=round(y1*1000)/1000;
a:=1;
b:=(-2)*a1;
c:=sqr(a1)+sqr(y1)+sqr(b1)-2*y1*b1-AB;
delta:=sqr(b)-4*a*c;
if delta>=0 then
begin
x1:=(-b+sqrt(delta))/(2*a);
x2:=(-b-sqrt(delta))/(2*a);
punct1.x:=round(x1*1000)/1000;
punct2.x:=round(x2*1000)/1000;
end
else da:=false
end
else if difo=0 then
begin
x1:=abscisa/(2*difa);
punct1.x:=round(x1*1000)/1000;
punct2.x:=round(x1*1000)/1000;
a:=1;
b:=(-2)*b1;
c:=sqr(a1)+sqr(x1)+sqr(b1)-2*x1*a1-AB;
delta:=sqr(b)-4*a*c;
if delta>=0 then
begin
y1:=(-b+sqrt(delta))/(2*a);
y2:=(-b-sqrt(delta))/(2*a);
punct1.y:=round(y1*1000)/1000;
punct2.y:=round(y2*1000)/1000;
end
else da:=false;
end
end;
function caut_binar(punct_p:punct):boolean;
var ok:boolean;
p,u,mij:longint;
begin
ok:=false;
p:=1;
u:=n;
while (p<=u) and not ok do
begin
mij:=(p+u) div 2;
if (v[mij].x<punct_p.x) or (v[mij].x=punct_p.x) and (v[mij].y<punct_p.y) then p:=mij+1
else if (v[mij].x>punct_p.x) or (v[mij].x=punct_p.x) and (v[mij].y>punct_p.y) then u:=mij-1
else if (v[mij].x=punct_p.x) and (v[mij].y=punct_p.y) then ok:=true
end;
caut_binar:=ok;
end;
procedure rezolvare;
var i,j:integer;
begin
nr:=0;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
gaseste_punct(v[i].x,v[i].y,v[j].x,v[j].y);
if da and caut_binar(punct1) then inc(nr);
if da and caut_binar(punct2) then inc(nr);
end;
end;
procedure afisare;
var g:text;
begin
assign(g,'triang.out'); rewrite(g);
writeln(g,nr);
close(g);
end;
begin
citire;
qsort(1,n);
rezolvare;
afisare;
end.