nearest2.pas

PASCAL光盘资料PASCAL光盘资料PASCAL光盘资料

Program The_Closest_Pair_Problem;

Const
  Maxn=10000;
  Maxnum=1e+20;

Type
  TPoint=Record
    x,y:Real;
  End;
  TArray=Array [1..Maxn] of Longint;

Var
  p:Array [1..Maxn] of TPoint;
  side,x,y:TArray;
  n:Longint;
  ans:Real;

  Function Input_Data:Boolean;
  Var
    i:Longint;
  Begin
    Read(n);
    If n=0
      Then Input_Data:=False
      Else Begin
        Input_Data:=True;
        For i:=1 to n Do Read(p[i].x,p[i].y);
      End;
  End;

  Function Dis(a,b:TPoint):Real;
  Begin
    Dis:=Sqrt(Sqr(a.x-b.x)+Sqr(a.y-b.y));
  End;

  Function Pre(a,b:TPoint; mark:Longint):Boolean;
  Begin
    If mark=0
      Then Pre:=(a.x<=b.x)
      Else Pre:=(a.y<=b.y);
  End;

  Procedure Qsort(Var order:TArray; h,t,mark:Longint);
  Var
    r,k,i,j:Longint;
  Begin
    r:=Random(t-h+1)+h;
    k:=order[r];
    order[r]:=order[h];
    i:=h; j:=t;
    While i<j Do
    Begin
      While (i<j) and Pre(p[k],p[order[j]],mark) Do Dec(j);
      order[i]:=order[j];
      While (i<j) and Pre(p[order[i]],p[k],mark) Do Inc(i);
      order[j]:=order[i];
    End;
    order[i]:=k;
    If h<i-1 Then Qsort(order,h,i-1,mark);
    If i+1<t Then Qsort(order,i+1,t,mark);
  End;

  Procedure Init;
  Var
    i:Longint;
  Begin
    For i:=1 to n Do
    Begin
      x[i]:=i; y[i]:=i;
    End;
    Qsort(x,1,n,0);
    Qsort(y,1,n,1);
  End;

  Function Find_Min(Var y:TArray; lowx,highx:Longint):Real;
  Var
    i,j,midx,nl,nr,upbound:Longint;
    t,ans,temp:Real;
    yl,yr:^TArray;
  Begin
    ans:=Maxnum;
    If highx-lowx+1<=3 Then
    Begin
      For i:=lowx to highx-1 Do
        For j:=i+1 to highx Do
        Begin
          temp:=Dis(p[x[i]],p[x[j]]);
          If temp<ans Then ans:=temp;
        End;
      Find_Min:=ans;
      Exit;
    End;
    midx:=(lowx+highx) div 2;
    For i:=lowx to midx Do side[x[i]]:=0;
    For i:=midx+1 to highx Do side[x[i]]:=1;
    GetMem(yl,Sizeof(Longint)*(highx-lowx+1)); nl:=0;
    GetMem(yr,Sizeof(Longint)*(highx-lowx+1)); nr:=0;
    For i:=lowx to highx Do
      If side[y[i-lowx+1]]=0
        Then Begin Inc(nl); yl^[nl]:=y[i-lowx+1] End
        Else Begin Inc(nr); yr^[nr]:=y[i-lowx+1] End;
    temp:=Find_Min(yl^,lowx,midx); If temp<ans Then ans:=temp;
    temp:=Find_Min(yr^,midx+1,highx); If temp<ans Then ans:=temp;
    t:=(p[x[midx]].x+p[x[midx+1]].x)/2;
    nl:=0;
    For i:=lowx to highx Do
      If Abs(p[y[i-lowx+1]].x-t)<ans Then
      Begin
        Inc(nl); yl^[nl]:=y[i-lowx+1];
      End;
    For i:=1 to nl-1 Do
    Begin
      upbound:=i+7; If nl<upbound Then upbound:=nl;
      For j:=i+1 to upbound Do
      Begin
        temp:=Dis(p[yl^[i]],p[yl^[j]]);
        If temp<ans Then ans:=temp;
      End;
    End;
    FreeMem(yl,Sizeof(Longint)*(highx-lowx+1));
    FreeMem(yr,Sizeof(Longint)*(highx-lowx+1));
    Find_Min:=ans;
  End;

  Procedure Solve;
  Begin
    Init;
    ans:=Find_Min(y,1,n);
  End;

  Procedure Output_Data;
  Begin
    If ans>=10000
      Then Writeln('INFINITY')
      Else Writeln(ans:0:4);
  End;

Begin
  Assign(Input,'closest.in');
  Assign(Output,'closest.out');
  Reset(Input);
  Rewrite(Output);

  While Input_Data Do
  Begin
    Solve;
    Output_Data;
  End;

  Close(Output);
  Close(Input);
End.