ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1111. Squares

I've trying all the way? I should so grateful If someone can find out the bugs.
Posted by Ural_BeeLiang 11 Nov 2002 15:57
{$N+}
const
maxn = 100;
zero = 1e-14;
type
tpoint = record
x, y: double;
end;
tsquare = record
p1, p2, p3, p4: tpoint;
end;
var
dis: array[1..maxn]of double;
sq: array[1..maxn]of tsquare;
num: array[1..maxn]of integer;
n, i, j, t0: integer;
p0: tpoint;
t: double;
function min(a, b, c, d: double): double;
var
res: double;
begin
res := a;
if b < res then res := b;
if c < res then res := c;
if d < res then res := d;
min := res;
end;

function distant(p1, p2: tpoint): double;
var
res: double;
begin
res := sqrt(sqr(p1.x - p2.x) + sqr(p1.y - p2.y));
distant := res;
end;

function d(pn, pm: tpoint): double;
var
res, p, a, b, c: double;
begin
a := distant(pn, p0);
b := distant(pm, p0);
c := distant(pn, pm);
if (a + b = c)or(a - b = c)or(b - a = c) then
begin
d := 0;
exit;
end;
if (a = 0)or(b = 0) then
begin
d := 0;
exit;
end;
if( (sqr(c) + sqr(b) - sqr(a))/(b * c) < 0 )
or( (sqr(c) + sqr(a) - sqr(b))/(a * c) < 0 ) then
res := min(a, b, maxlongint, maxlongint)
else
begin
p := (a + b + c) / 2;
res := 2 * sqrt(p * (p - a) * (p - b) * (p - c)) / c;
end;
d := res;

end;

begin
readln(n);
fillchar(sq, sizeof(sq), 0);
fillchar(dis, sizeof(dis), 0);
for i := 1 to n do
with sq[i] do
begin
readln(p1.x, p1.y, p3.x, p3.y);
p2.x := (p1.x + p3.x) / 2 - (p3.y - p1.y) / 2;
p2.y := p3.y - (p1.x - p2.x);
p4.x := (p1.x + p3.x) / 2 + (p3.y - p1.y) / 2;
p4.y := p1.y + (p4.x - p3.x);
end;
readln(p0.x, p0.y);
for i := 1 to n do
with sq[i] do
begin
dis[i] := min(d(p1, p2), d(p2, p3), d(p3, p4), d(p4, p1));
if abs(d(p2, p3) + d(p4, p1) - distant(p1, p2)) <= 1e-10 then
dis[i] := 0;
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 dis[i] > dis[j] then
begin
t := dis[i]; dis[i] := dis[j]; dis[j] := t;
t0 := num[i]; num[i] := num[j]; num[j] := t0;
end
else if abs(dis[i] - dis[j]) <= zero then
if num[i] > num[j] then
begin
t0 := num[i]; num[i] := num[j]; num[j] := t0;
end;
for i := 1 to n do write(num[i], ' ');
end.