WA HELP 1
Posted by
Oleg 16 Jan 2003 09:19
var i,j,k,n,m:integer;
x,y:integer;
a:array [1..100,1..4] of integer;
r:array [0..100] of real;
b:array [0..100] of integer;
function minr(a,b : real):real;
begin
if a<b then minr := a else minr := b;
end;
function min(a,b : integer):integer;
begin
if a<b then min := a else min := b;
end;
function max(a,b : integer):integer;
begin
if a>b then max := a else max := b;
end;
function len(x1,y1,x2,y2: real):real;
begin
len := sqrt(sqr(x2-x1)+sqr(y2-y1));
end;
function ins(x1,x2,x : integer) : boolean;
begin
if (x>=min(x1,x2)) and (x<=max(x1,x2)) then begin
ins := true;
end else ins := false;
end;
function sq_dis(x1,y1,x2,y2,x3,y3,x4,y4 : integer): real;
var d1,d2,d3,d4 : real;
begin
if ins(x1,x2,x) and ins(y1,y2,y) then begin
sq_dis := 0;
exit;
end;
if ins(x1,x2,x) then begin
d1 := abs(y1-y);
end else begin
d1 := minr(len(x,y,x1,y1),len(x,y,x2,y2));
end;
if ins(x3,x4,x) then begin
d2 := abs(y3-y);
end else begin
d2 := minr(len(x,y,x3,y3),len(x,y,x4,y4));
end;
if ins(y1,y4,y) then begin
d3 := abs(x4-x);
end else begin
d3 := minr(len(x,y,x1,y1),len(x,y,x4,y4));
end;
if ins(y2,y3,y) then begin
d4 := abs(x3-x);
end else begin
d4 := minr(len(x,y,x2,y2),len(x,y,x3,y3));
end;
sq_dis := minr(minr(minr(d1,d2),d3),d4);
end;
function proov(k:integer):real;
var x1,x2,y1,y2:integer;
function min(a,b:integer):integer;
begin
if a<b then min:=a else min:=b;
end;
function max(a,b:integer):integer;
begin
if a>b then max:=a else max:=b;
end;
begin
x1:=min(a[k,1],a[k,3]);
y1:=max(a[k,2],a[k,4]);
x2:=max(a[k,1],a[k,3]);
y2:=min(a[k,2],a[k,4]);
proov:=sq_dis(x1,y1,x2,y1,x2,y2,x1,y2);
end;
begin
read(n);
for i:=1 to n do
begin
for j:=1 to 4
do read(a[i,j]);
b[i]:=i;
end;
read(x,y);
for i:=1 to n do r[i]:=proov(i);
for i:=1 to n do
begin
for j:=i+1 to n do
begin
if r[i]>r[j] then
begin
r[0]:=r[i]; r[i]:=r[j]; r[j]:=r[0];
b[0]:=b[i]; b[i]:=b[j]; b[j]:=b[0];
end;
end;
end;
for i:=1 to n do writeln(b[i],' ',r[i]:0:0)
end.