Pagini recente » Cod sursa (job #5039) | Cod sursa (job #2260553) | Cod sursa (job #170257) | Cod sursa (job #863117) | Cod sursa (job #12524)
Cod sursa(job #12524)
//patrate 3
const a = (sqrt(5)-1)/2;
hashmax = 2000;
type pc= record
x,y:real;
end;
pnody = ^tnody;
tnody = record
val:real;
next : pnody;
end;
listay = record
heady,lasty:pnody;
end;
pnodx = ^tnodx;
tnodx = record
val:real;
yy : array[0..hashmax] of listay;
next:pnodx;
end;
listax = record
headx,lastx:pnodx;
end;
var n,rez:longint;
pcc:array[0..hashmax] of listax;
puncte : array[0..1000] of pc;
function hash(x:real):integer;
begin
hash:= abs(trunc(hashmax * ( frac(x*a) )));
end;
function egal(x,y:real):boolean;
begin
if abs(x-y) < 0.0001 then egal:=true
else egal:=false;
end;
procedure inserthash(z:pc);
var fx,fy,i:integer;
p,pp:pnodx;
q,qq:pnody;
begin
fx:=hash(z.x);
p:=pcc[fx].headx;
while p<> nil do
begin
if egal(p^.val,z.x) then
begin
fy:=hash(z.y);
new(q);
q^.val:=z.y; q^.next:=nil;
if p^.yy[fy].heady = nil then
p^.yy[fy].heady:=q
else p^.yy[fy].lasty^.next:=q;
p^.yy[fy].lasty:=q;
break;
end;
p:=p^.next;
end;
if p = nil then
begin
new(pp); pp^.val:=z.x; pp^.next:=nil;
fy:=hash(z.y);
for i:=0 to hashmax do
begin
pp^.yy[i].heady:=nil; pp^.yy[i].lasty:=nil
end;
new(qq);
qq^.val:=z.y; qq^.next:=nil;
pp^.yy[fy].heady:=qq;
pp^.yy[fy].lasty:=qq;
if pcc[fx].headx = nil then pcc[fx].headx:=pp
else pcc[fx].lastx^.next:=pp;
pcc[fx].lastx:=pp;
end;
end;
function cautahash(z:pc):boolean;
var p:pnodx;
q:pnody;
fx,fy:integer;
begin
cautahash:=false;
fx:=hash(z.x);
p:=pcc[fx].headx;
while p<> nil do
begin
if egal(p^.val,z.x) then
begin
fy:=hash(z.y);
q:=p^.yy[fy].heady;
while q<> nil do
begin
if egal(q^.val,z.y) then
begin
cautahash:=true;
exit;
end;
q:=q^.next;
end;
end;
p:=p^.next;
end;
end;
procedure citire;
var i:integer;
z:pc;
begin
assign(input,'patrate3.in'); reset(input);
readln(n);
for i:=1 to n do
begin
readln(z.x,z.y);
puncte[i]:=z;
inserthash(z);
end;
close(input);
end;
procedure mutapuncte( p0,p1:pc; var p2,p3:pc);
begin
if p0.x < p1.x then begin p2:=p0; p3:=p1; end
else begin p2:=p1; p3:=p0; end;
end;
procedure calc;
var i,j:integer;
d,mij,p1,p2,p01,p02:pc;
begin
for i:=1 to n do
for j:=1 to n do
if (i<>j) then
begin
mutapuncte(puncte[i],puncte[j],p01,p02);
mij.x:=(p01.x+p02.x)/2;
mij.y:=(p01.y+p02.y)/2;
d.x:=abs(mij.x-p01.x);
d.y:=abs(mij.y-p01.y);
if p01.y < p02.y then
begin
p1.x:=mij.x+d.y;
p1.y:=mij.y-d.x;
p2.x:=mij.x-d.y;
p2.y:=mij.y+d.x;
end
else
begin
p1.x:=mij.x-d.y;
p1.y:=mij.y-d.x;
p2.x:=mij.x+d.y;
p2.y:=mij.y+d.x;
end;
if cautahash(p1) and
cautahash(p2) then
inc(rez);
end;
end;
begin
citire;
calc;
assign(output,'patrate3.out'); rewrite(output);
writeln(rez div 4);
close(output);
end.