Pagini recente » Cod sursa (job #592033) | Cod sursa (job #600261) | Cod sursa (job #2878885) | Cod sursa (job #1239594) | Cod sursa (job #14921)
Cod sursa(job #14921)
//patrate 3
const a = (sqrt(5)-1)/2;
hashmax = 20000;
type pc= record
x,y:real;
end;
pnod = ^tnod;
tnod = record
x:pc;
next:pnod;
end;
lista = record
head,last:pnod;
end;
var n,rez:longint;
pcc:array[0..hashmax] of lista;
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 poz,i:integer;
p:pnod;
begin
poz:=hash(z.x+z.y);
new(p); p^.x:=z; p^.next:=nil;
if pcc[poz].head = nil then
pcc[poz].head:=p
else pcc[poz].last^.next:=p;
pcc[poz].last:=p;
end;
function cautahash(z:pc):boolean;
var p:pnod;
poz:integer;
begin
cautahash:=false;
poz:=hash(z.x+z.y);
p:=pcc[poz].head;
while p <> nil do
begin
if egal(p^.x.x, z.x) and egal(p^.x.y, z.y) then
cautahash:=true;
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:=i+1 to n do
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 2);
close(output);
end.