I got WA, help me, please!!!
Posted by
plg 14 Jun 2003 23:04
const
max = 100;
maxC = 10000;
type
TRect = record
x1, x2, y1, y2 : double;
end;
var
n, x0, y0 : Integer;
R : array[1..max] of TRect;
ID : array[1..max] of Integer;
{*************************}
procedure swap(var i, j : double);
var
tmp : double;
begin
tmp := i; i := j; j := tmp;
end;
{*************************}
procedure read_f;
var
i : Integer;
x1, x2, y1, y2 : double;
begin
readln( n);
for i := 1 to n do
with R[i] do
begin
Id[i] := i;
readln( x1, y1, x2, y2);
if x1 > x2 then swap(x1, x2);
if y1 > y2 then swap(y1, y2);
end;
readln( x0, y0);
end;
{*************************}
function long(x1, y1, x2, y2 : double) : double;
begin
long := Sqrt(sqr(x1 - x2) + sqr(y1 - y2));
end;
{*************************}
function inside(i : Integer) : Boolean;
begin
with R[i] do
inside := (x0 >= x1) and (x0 <= x2) and (y0 >= y1) and (y0 <= y2);
end;
{*************************}
function path(i : Integer) : double;
var
tmp : double;
begin
if inside(i) then
begin
path := 0;
exit;
end;
with R[i] do
begin
tmp := 0;
if (x1 <= x0) and (x0 <= x2) then
begin
tmp := maxLongInt;
if tmp > abs(y0 - y1) then tmp := abs(y0 - y1);
if tmp > abs(y0 - y2) then tmp := abs(y0 - y2);
path := tmp; exit;
end;
if (y1 <= y0) and (y0 <= y2) then
begin
tmp := maxLongInt;
if tmp > abs(x0 - x1) then tmp := abs(x0 - x1);
if tmp > abs(x0 - x2) then tmp := abs(x0 - x2);
path := tmp; exit;
end;
tmp := maxLongInt;
if tmp > long(x1, y1, x0, y0) then tmp := long(x1, y1, x0, y0);
if tmp > long(x1, y2, x0, y0) then tmp := long(x1, y2, x0, y0);
if tmp > long(x2, y1, x0, y0) then tmp := long(x2, y1, x0, y0);
if tmp > long(x2, y2, x0, y0) then tmp := long(x2, y2, x0, y0);
path := tmp; exit;
end;
end;
{*************************}
procedure solve;
var
i, j, tmp : Integer;
t1 : double;
begin
for i := 1 to n do
for j := i + 1 to n do
if Path(Id[i]) - Path(Id[j]) > (1e-14) then
begin
tmp := Id[i]; Id[i] := Id[j]; Id[j] := tmp;
end;
end;
{*************************}
procedure print;
var
i : Integer;
begin
for i := 1 to n do write( Id[i], ' ');
end;
{*************************}
begin
read_f;
solve;
print;
end.