Cod sursa(job #610968)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 29 august 2011 23:43:07
Problema Patrate 3 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.58 kb
Program patrate3;
type punct=record
     x,y:double;
     end;
var a:array [0..1010] of punct;
    n,i,j,cnt:integer;
    rez:longint;
    x2,y2,x3,y3,midx,midy,dx,dy:double;
    fi,fo:text;
procedure qsort(l,r:integer);
 var i,j:integer;
     y:punct;
     k:double;
 begin
  i:=l; j:=r;
   k:=a[(l+r) div 2].x;
 repeat
  while (a[i].x<k) or ((a[i].x=k) and (a[i].y<a[(l+r) div 2].y)) do inc(i);
   while (a[j].x>k) or ((a[i].x=k) and (a[i].y>a[(l+r) div 2].y)) do dec(j);
 if i<=j then
              begin
               y:=a[i];
                a[i]:=a[j];
                  a[j]:=y;
                     inc(i); dec(j);
              end;
 until i>=j;
  if l<j then qsort(l,j);
   if i<r then qsort(i,r);
 end;
procedure cauta(st,dr:integer; x,y:double);
var mid:integer;
begin
if st<=dr then begin
 mid:=(st+dr) div 2;
  if a[mid].x>x then cauta(st,mid-1,x,y)
   else if a[mid].x=x then begin
                     if a[mid].y>y then cauta(st,mid-1,x,y);
                     if a[mid].y<y then cauta(mid+1,dr,x,y);
                       end;
  if a[mid].x<x then cauta(mid+1,dr,x,y)
   else if a[mid].x=x then begin
                    if a[mid].y>y then cauta(st,mid-1,x,y);
                     if a[mid].y<y then cauta(mid+1,dr,x,y);
                           end;
  if (a[mid].x=x) and (a[mid].y=y) then inc(cnt);
                end;
end;
begin
 assign(fi,'patrate3.in');
  assign(fo,'patrate3.out');
 reset(fi);
  rewrite(fo);
 readln(fi,n);
  for i:=1 to n do readln(fi,a[i].x,a[i].y);
 qsort(1,n);
  for i:=1 to n-1 do
   for j:=i+1 to n do begin
                      cnt:=0;
                      midx:=(a[i].x+a[j].x)/(2);
                      midy:=(a[i].y+a[j].y)/(2);
                      dx:=abs(midx-a[i].x);
                      dy:=abs(midy-a[i].y);
                       if a[i].y<a[j].y then begin
                                              x2:=midx+dy;
                                              y2:=midy-dx;
                                              x3:=midx-dy;
                                              y3:=midy+dx;
                                              end
                        else begin
                              x2:=midx-dy;
                              y2:=midy-dx;
                              x3:=midx+dy;
                              y3:=midy+dx;
                              end;
                       cauta(1,n,x2,y2);
                        if cnt=1 then cauta(1,n,x3,y3);
                        if cnt=2 then inc(rez);
                       end;
 write(fo,rez);
close(fo);
end.