WA HELP 2 Posted by Oleg 16 Jan 2003 09:20 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 : 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); d2:=abs(y2-y); d3:=abs(y1-y); d4:=abs(y2-y); end else begin if ins(y1,y2,y) then begin d1:=abs(x1-x); d2:=abs(x2-x); d3:=abs(x1-x); d4:=abs(x1-x); end else begin d1:=len(x1,y1,x,y); d2:=len(x2,y2,x,y); d3:=len(x2,y1,x,y); d4:=len(x1,y2,x,y); end; 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,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. WA AGAIN Posted by Oleg 16 Jan 2003 14:14 const eps=1e-14; 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 : 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); d2:=abs(y2-y); d3:=abs(y1-y); d4:=abs(y2-y); end else begin if ins(y1,y2,y) then begin d1:=abs(x1-x); d2:=abs(x2-x); d3:=abs(x1-x); d4:=abs(x1-x); end else begin d1:=len(x1,y1,x,y); d2:=len(x2,y2,x,y); d3:=len(x2,y1,x,y); d4:=len(x1,y2,x,y); end; 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,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])>eps 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 begin for j:=i+1 to n do begin if (abs(r[i]-r[j])<eps) and (b[i]>b[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-1 do write(b[i],' '); writeln(b[n]); end. |