Could you help me please ? thanks a lot !!!!!
Послано
XueMao 15 мар 2003 12:39
Why I get WA ??? I can not find the error any where
{$n+}
Program Square;
Type Lion=record
x,y:double;
end;
xm=array[1..4] of Lion;
Var i,j,k,m,n,k1,k2:longint;
V:xm;
a:array[0..100] of xm;
dis,x,y,sum,min:double;
distance:array[0..100] of double;
num:array[0..100] of integer;
Function Long(x,y,x1,y1:double):double;
begin
Long:=sqrt(sqr(x1-x)+sqr(y1-y));
end;
Procedure Init;
Var Long1,arc,arc1:double;
Begin
fillchar(v,sizeof(v),0);
read(v[1].x,v[1].y,v[3].x,v[3].y);
Long1:=Long(v[1].x,v[1].y,v[3].x,v[3].y)/sqrt(2);
if v[1].x=v[3].x then
begin
v[2].x:=v[1].x-Long1/sqrt(2);
v[2].y:=(v[1].y+v[3].y)/2;
v[4].x:=v[1].x+Long1/sqrt(2);
v[4].y:=(v[1].y+v[3].y)/2;
end
else
begin
arc:=arctan((v[3].y-v[1].y)/(v[3].x-v[1].x));
if v[3].x-v[1].x<0 then arc:=arc+pi;
arc1:=arc+pi/4;
v[2].y:=v[1].y+Long1*sin(arc1);
v[2].x:=v[1].x+Long1*cos(arc1);
arc1:=arc-pi/4;
v[4].y:=v[1].y+Long1*sin(arc1);
v[4].x:=v[1].x+Long1*cos(arc1);
end;
End;
Function Get(x1,y1,x2,y2:double):double;
var k,k1,b,b1,xx,yy,Long1,Long2:double;
begin
if x1=x2 then
begin
xx:=x1;
yy:=y;
end
else
if y1<>y2 then
begin
k:=(y2-y1)/(x2-x1);
b:=y1-k*x1;
k1:=-1/k;
b1:=y-k1*x;
xx:=(b1-b)/(k-k1);
yy:=xx*k1+b1;
end
else
begin
xx:=x;
yy:=y1;
end;
if ((yy>=y1)and(yy<=y2)or(yy>=y2)and(yy<=y1))
and((xx>=x1)and(xx<=x2)or(xx>=x2)and(xx<=x1)) then
Get:=Long(xx,yy,x,y)
else
begin
Long1:=Long(x1,y1,x,y);
Long2:=Long(x2,y2,x,y);
if Long1<Long2 then Get:=Long1
else Get:=Long2;
end;
sum:=sum+Long(xx,yy,x,y);
end;
Begin
read(n);
fillchar(a,sizeof(a),0);
fillchar(distance,sizeof(distance),0);
for i:=1 to n do
begin
Init;
a[i]:=v;
end;
read(x,y);
for i:=1 to n do
begin
Min:=1e100;
sum:=0;
for j:=1 to 4 do
begin
k1:=j;
if j=4 then k2:=1
else k2:=j+1;
dis:=get(a[i,k1].x,a[i,k1].y,a[i,k2].x,a[i,k2].y);
if dis<min then
Min:=dis;
end;
if abs(sum-Long(a[i,1].x,a[i,1].y,a[i,3].x,a[i,3].y)*sqrt(2))<1e-
14
then distance[i]:=0
else distance[i]:=Min;
end;
for i:=1 to n do num[i]:=i;
for i:=1 to n-1 do
for j:=i+1 to n do
if distance[j]<distance[i] then
begin
k:=num[i];
num[i]:=num[j];
num[j]:=k;
dis:=distance[i];
distance[i]:=distance[j];
distance[j]:=dis;
end;
for i:=1 to n do write(num[i],' ');
End.