Cod sursa(job #14920)

Utilizator andrei_infoMirestean Andrei andrei_info Data 10 februarie 2007 11:25:57
Problema Patrate 3 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.81 kb
//patrate 3
const a = (sqrt(5)-1)/2;
      hashmax = 6000;
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.