Cod sursa(job #10996)

Utilizator gurneySachelarie Bogdan gurney Data 30 ianuarie 2007 09:01:50
Problema Patrate 3 Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.68 kb
program patrate3;
  const
    fin='patrate3.in';
    fout='patrate3.out';
    eps=0.0001;
    nmax=1000;
  var
    px,py:array[1..nmax] of real;
    x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,dx,dy:real;
    n,i,j,k,x,count:longint;
  function find (x,y:real):boolean;
    var
      st,dr,m:integer;
    begin
      st:=1;dr:=n;
      m:=(st+dr)shr 1;
      while (st<=dr)and((abs(px[m]-x)>eps)and(abs(py[m]-y)>eps)) do
        begin
          if px[m]=x then
            begin
              if py[m]>y then
                dr:=m-1
              else
                st:=m+1;
            end
          else
            begin
              if px[m]>x then
                dr:=m-1
              else
                st:=m+1;
            end;
          m:=(st+dr) shr 1;
        end;
      if ((abs(px[m]-x)<eps)and(abs(py[m]-y)<eps)) then
        find:=true
      else
        find:=false;
    end;

  procedure scufundare(i,nh:integer);
    var
      p:integer;
      aux:real;
    begin
      p:=i;
      if i shl 1<=nh then
        if (px[i shl 1]>px[p]) or ((abs(px[i shl 1]-px[p])<eps)and(py[i shl 1]>py[p]))then
          p:=i shl 1;
      if i shl 1 or 1<=nh then
        if (px[i shl 1 or 1]>px[p]) or ((abs(px[i shl 1 or 1]-px[p])<eps)and(py[i shl 1 or 1]>py[p]))then
          p:=i shl 1 or 1;
      if p<>i then
        begin
          aux:=px[i];px[i]:=px[p];px[p]:=aux;
          aux:=py[i];py[i]:=py[p];py[p]:=aux;
          scufundare(p,nh);
        end;
    end;

  procedure sort;
    var
      aux:real;
      i:integer;
    begin
      for i:=n shr 1 downto 1 do
        scufundare(i,n);
      for i:=n downto 2 do
        begin
          aux:=px[1];px[1]:=px[i];px[i]:=aux;
          aux:=py[1];py[1]:=py[i];py[i]:=aux;
          scufundare(1,i-1);
        end;
    end;
begin
  assign(input,fin);
    reset(input);
    readln(n);
    for i:=1 to n do
      begin
        readln(px[i],py[i]);
      end;
  close(input);
  assign(output,fout);
    rewrite(output);
    sort;
    for i:=1 to n-1 do
      for j:=i+1 to n do
        begin
          x0:=px[i];y0:=py[i];
          x1:=px[j];y1:=py[j];
          x4:=(x0+x1)/2;
          y4:=(y0+y1)/2;
          dx:=abs(x4-x0);dy:=abs(y4-y0);
          if y0<y1 then
            begin
              x2:=x4+dy;
              y2:=y4-dx;
              x3:=x4-dy;
              y3:=y4+dx;
            end
          else
            begin
              x2:=x4-dy;
              y2:=y4-dx;
              x3:=x4+dy;
              y3:=y4+dx;
            end;
          if (find(x2,y2)) and (find(x3,y3)) then
            inc(count);
        end;
    writeln(count shr 1);
  close(output);
end.