Cod sursa(job #36480)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 23 martie 2007 16:54:39
Problema Patrate 3 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.95 kb
type coord=record
              x,y:real;
           end;
var v:array[1..1000] of coord;
   f,g:text;
     n,i,c,j:integer;
     ordo:boolean;
     aux:coord;
     a,b,q:integer;
     xx,yy,dx,dy,mijx,mijy,x1,x2,y1,y2:real;
function cauta(a,b:integer; xx,yy:real):boolean;
   var ok:boolean;
   begin
       if a>b then ok:=false
         else
           begin
            c:=(a+b) div 2;
            if xx<v[c].x then ok:=cauta(a,c-1,xx,yy)
              else if xx>v[c].x then ok:=cauta(c+1,b,xx,yy)
                else begin
                        if yy<v[c].y then ok:=cauta(a,c-1,xx,yy)
                          else if yy>v[c].y then ok:=cauta(c+1,b,xx,yy)
                            else ok:=true;
                     end; end;
         cauta:=ok;
   end;
begin
assign(f,'patrate3.in');
reset(f);
readln(f,n);
for i:=1 to n do readln(f,v[i].x,v[i].y);
close(f);
repeat
   ordo:=true;
  for i:=1 to n-1 do
     if v[i].x>v[i+1].x then
        begin
          ordo:=false;
          aux:=v[i]; v[i]:=v[i+1]; v[i+1]:=aux;
        end
          else if (v[i].x=v[i+1].x)and(v[i].y>v[i+1].y) then
              begin
                ordo:=false;
                aux:=v[i]; v[i]:=v[i+1]; v[i+1]:=aux;
              end;
until ordo;
q:=0;
for i:=1 to n do
  for j:=i+1 to n do
    begin
      mijx:=(v[i].x+v[j].x)/2;
      mijy:=(v[i].y+v[j].y)/2;
      dx:=abs(mijx-v[i].x);
      dy:=abs(mijy-v[i].y);
      y1:=mijy-dx;
      y2:=mijy+dx;
      if v[i].y<v[j].y  then
        begin
          x1:=mijx+dy;
          x2:=mijx-dy;
          if cauta(j+1,n,x1,y1) then
            if cauta(j+1,n,x2,y2) then inc(q);
        end
            else
              begin
                 x1:=mijx-dy;
                 x2:=mijx+dy;
                 if cauta(j+1,n,x1,y1) then
                    if cauta(j+1,n,x2,y2) then inc(q);
              end;
    end;
assign(g,'patrate3.out');
rewrite(g);
writeln(g,q);
close(g);
end.