Cod sursa(job #176169)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 10 aprilie 2008 20:18:11
Problema Patrate 3 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
type point=record
     x,y:double;
     end;

const er=0.0001;
var a,b:array[1..1000] of point;
    w:point;
    f,g:text;
    nr,i,j,n,e,r:longint;
    x,y:extended;

procedure inter(st,dr,mij:longint);
 var i,j,t,k:longint;
 begin
  for i:=st to dr do
   b[i]:=a[i];
  i:=st; k:=st; j:=mij+1;
  while (i<=mij) and (j<=dr) do begin
   if (b[i].x<b[j].x) or
   ((abs(b[i].x-b[j].x)<=er) and (b[i].y<b[j].y)) then begin
    a[k]:=b[i];
    inc(i);
   end
   else begin
    a[k]:=b[j];
    inc(j);
   end;
   inc(k);
  end;
  for t:=i to mij do
   a[k+t-i]:=b[t];
  for t:=j to dr do
   a[k+t-j]:=b[t];
 end;

procedure merge(st,dr:longint);
 var mij:longint;
 begin
  if st<dr then begin
   mij:=(st+dr) shr 1;
   merge(st,mij);
   merge(mij+1,dr);
   inter(st,dr,mij);
  end;
 end;


function cauta(st,dr:longint):longint;
 var mij:longint;
 begin
  if st>dr then cauta:=0
  else begin
   mij:=(st+dr) shr 1;
   if (abs(a[mij].x-w.x)<=er) and (abs(a[mij].y-w.y)<=er) then
    cauta:=mij
   else
    if (abs(a[mij].x-w.x)<=er) then
     if a[mij].y<w.y then
      cauta:=cauta(mij+1,dr)
     else
      cauta:=cauta(st,mij-1)
    else
     if (a[mij].x<w.x) then
      cauta:=cauta(mij+1,dr)
     else
      cauta:=cauta(st,mij-1);
  end;
 end;

begin
 assign(f,'patrate3.in'); reset(f);
 assign(g,'patrate3.out'); rewrite(g);
 read(f,n);
 for i:=1 to n do
  read(f,a[i].x,a[i].y);
 merge(1,n);
 for i:=2 to n do
  for j:=1 to i-1 do begin
   x:=a[i].x-a[j].x;
   y:=a[i].y-a[j].y;
   w.x:=a[j].x+y;
   w.y:=a[j].y-x;
   e:=cauta(1,n);
   w.x:=a[i].x+y;
   w.y:=a[i].y-x;
   r:=cauta(1,n);
   if (x>=0) and (y>=0) and (r<>0) and (e<>0) and (r<>i) and (r<>j) and (e<>i) and (e<>j) then
    inc(nr);
  end;
 writeln(g,nr);
 close(f); close(g);
end.