Cod sursa(job #13463)

Utilizator alex_dincaDinca Alexandru-Nicolae - UPB alex_dinca Data 6 februarie 2007 18:52:26
Problema Triang Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
type punct=record
     x,y:real;
     end;
var p:array[1..1500] of punct;
    x:array[1..3] of 1..1500;
    f:text;ok:boolean;
    n,i,j,k,nr:integer;
    d:real;

function dist(a,b:punct):real;
var di:real;
begin
di:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y));
dist:=di;
end;


procedure citire;
begin
assign(f,'triang.in');reset(f);
readln(f,n);
for i:=1 to n do readln(f,p[i].x,p[i].y);
close(f);
end;

procedure afis;
begin
assign(f,'triang.out');rewrite(f);
writeln(f,nr);
close(f);
end;

function cont(k:integer):boolean;
var i:integer;
begin
cont:=true;
for i:=1 to k-1 do
if (x[k]<=x[k-1]) then cont:=false;
end;

procedure retsol;
begin
ok:=true;
d:=dist(p[x[1]],p[x[2]]);
if round(d)<>round(dist(p[x[2]],p[x[3]])) then ok:=false;
if ok then
   if round(d)<>round(dist(p[x[1]],p[x[3]])) then ok:=false;
if ok then nr:=nr+1;
end;

procedure BKT(k:integer);
var i:integer;
begin
if k=4 then retsol
else for i:=1 to n do begin
         x[k]:=i;
         if cont(k) then BKT(k+1);
         end;
end;


begin
citire;
bkt(1);
afis;
end.