Online JudgeProblem SetAuthorsOnline ContestsUser
Web Board
Home Page
F.A.Qs
Statistical Charts
Problems
Submit Problem
Online Status
Prob.ID:
Register
Update your info
Authors ranklist
Current Contest
Past Contests
Scheduled Contests
Award Contest
User ID:
Password:
  Register

贴下pascal代码

Posted by jinzhihan at 2015-06-26 22:08:11 on Problem 3608
const
  inf=1e9;
  eps=1e-7;
  maxn=10010;
type
  vector=record
    x,y:double;
  end;
  arr=array[0..maxn*2] of vector;
var
  a,b:arr;
  n,m,i,j:longint;
  ans:double;

operator +(a,b:vector)c:vector;
begin
  c.x:=a.x+b.x; c.y:=a.y+b.y;
end;

operator -(a,b:vector)c:vector;
begin
  c.x:=a.x-b.x; c.y:=a.y-b.y;
end;

function min(x,y:double):double;
begin
  if x>y then min:=y else min:=x;
end;

function dis(a:vector):double;
begin
  dis:=sqrt(a.x*a.x+a.y*a.y);
end;

function dot(a,b:vector):double;
begin
  dot:=a.x*b.x+a.y*b.y;
end;

function cross(a,b:vector):double;
begin
  cross:=a.x*b.y-a.y*b.x;
end;

function getdis(a,b,c:vector):double;
begin
  if (dot(a-b,c-b)<-eps) or (dot(b-c,a-c)<-eps)
    then getdis:=inf
    else getdis:=abs(cross(b-a,c-a))/dis(b-c);
end;

procedure swap(var a,b:vector);
var
  temp:vector;
begin
  temp:=a; a:=b; b:=temp;
end;

function findmin(a:arr;n:longint):longint;
var
  num,i:longint;
begin
  num:=1;
  for i:=2 to n do
    if a[i].y<a[num].y then num:=i;
  findmin:=num;
end;

function findmax(a:arr;n:longint):longint;
var
  num,i:longint;
begin
  num:=1;
  for i:=2 to n do
    if a[i].y>a[num].y then num:=i;
  findmax:=num;
end;

procedure qsort(var a:arr;l,r:longint);
  procedure sort(l,r:longint);
  var
    i,j:longint;
    mid:vector;
  begin
    i:=l; j:=r; mid:=a[(i+j) shr 1];
    repeat
      while cross(a[i],mid)>0 do inc(i);
      while cross(mid,a[j])>0 do dec(j);
      if not (i>j)
        then begin swap(a[i],a[j]); inc(i); dec(j); end;
    until i>j;
    if i<r then sort(i,r);
    if j>l then sort(l,j);
  end;
begin
  sort(l,r);
end;

procedure graham(var a:arr;n:longint);
var
  num,i:longint;
  temp:vector;
begin
  num:=findmin(a,n); swap(a[1],a[num]); temp:=a[1];
  for i:=1 to n do a[i]:=a[i]-temp;
  qsort(a,2,n);
  for i:=1 to n do a[i]:=a[i]+temp;
end;

procedure solve(a:arr;n,h:longint;b:arr;m,j:longint);
var
  i:longint;
begin
  for i:=h to h+n-1 do
    begin
      while (cross(a[i+1]-a[i],b[j+1]-b[j])>0) do inc(j);
      ans:=min(ans,dis(b[j]-a[i]));
      ans:=min(ans,dis(b[j]-a[i+1]));
      ans:=min(ans,dis(b[j+1]-a[i]));
      ans:=min(ans,dis(b[j+1]-a[i+1]));
      ans:=min(ans,getdis(b[j],a[i],a[i+1]));
      ans:=min(ans,getdis(b[j+1],a[i],a[i+1]));
    end;
end;

begin
  while true do
    begin
      readln(n,m);
      if n=0 then halt;
      for i:=1 to n do readln(a[i].x,a[i].y);
      for i:=1 to m do readln(b[i].x,b[i].y);

      graham(a,n);
      graham(b,m);

      ans:=inf;
      for i:=n+1 to n*2 do a[i]:=a[i-n];
      for i:=m+1 to m*2 do b[i]:=b[i-m];
      solve(a,n,findmin(a,n),b,m,findmax(b,m));
      solve(b,m,findmin(b,m),a,n,findmax(a,n));
      writeln(ans:0:5);
    end;
end.

Followed by:

Post your reply here:
User ID:
Password:
Title:

Content:

Home Page   Go Back  To top


All Rights Reserved 2003-2013 Ying Fuchen,Xu Pengcheng,Xie Di
Any problem, Please Contact Administrator