RE: RE: rectangle intersection
- To: mathgroup at smc.vnet.net
- Subject: [mg36146] RE: [mg36124] RE: [mg36093] rectangle intersection
- From: "Hans J.I. Michel" <hansjm at bellsouth.net>
- Date: Fri, 23 Aug 2002 00:25:20 -0400 (EDT)
- Reply-to: <hansjm at bellsouth.net>
- Sender: owner-wri-mathgroup at wolfram.com
Frank
This may not be applicable to your case you probably need to test many
rectangles. But try this anyway.
ShowOverlap[{{ax0_, ay0_, ax1_, ay1_}, {bx0_, by0_, bx1_, by1_}}] := Show[
Graphics3D[
First[Show[
Graphics3D[
{{SurfaceColor[GrayLevel[.5], GrayLevel[.5], 5],
Cuboid[{ax0, ay0, 0}, {ax1, ay1, 0}]}, {SurfaceColor[
GrayLevel[.3], GrayLevel[.3], 5],
Cuboid[{bx0, by0, 0}, {bx1, by1, 0}]}}], Boxed -> False,
PolygonIntersections -> False]
]
]
, Boxed -> False, Lighting -> False];
ShowOverlap[{{0, 0, 5, 1}, {3, 0, 4, 2}}]
The shading is lacking in some examples I ran. However the important thing
is that you get a quick visual confirmation that the rectangles overlap. If
you change the edge colors I think that will help the display.
I thought this was a fast implementation.
Additionally, I was looking into the Built in Rectangle function and the
statement in the help file which states
"When rectangles overlap, their backgrounds are effectively taken to be
transparent."
I was trying to figure out how to use this to our advantage since it can be
used to represent a state (Overlap -> Transparent, NoOverlap -> Not
Transparent).
Hans
-----Original Message-----
From: DrBob [mailto:majort at cox-internet.com]
To: mathgroup at smc.vnet.net
'Andrzej Kozlowski'; 'Hans Michel'; 'David Park'
Subject: [mg36146] RE: [mg36124] RE: [mg36093] rectangle intersection
Here's a solution using LinearProgramming. It's a little slower than
"intersects" (20% maybe), but it's a lot easier to do and easier to
generalize to other convex polygons. Somebody will probably do better
using Solve or Reduce, since optimization is unnecessary.
Off[LinearProgramming::"lpsnf"]
intersectLP[r1_, r2_] := Head@LinearProgramming[
{1, 1, 1, 1, 1, 1, 1, 1},
Transpose@Join[r1, -r2]~Join~{{1, 1, 1, 1, 0, 0, 0,
0}, {0, 0, 0, 0, 1, 1, 1, 1}},
{{0, 0}, {0, 0}, {1, 0}, {1, 0}}
] =!= LinearProgramming
Bobby Treat
-----Original Message-----
From: DrBob [mailto:majort at cox-internet.com]
To: mathgroup at smc.vnet.net
'Andrzej Kozlowski'; 'Hans Michel'; 'David Park'
Subject: [mg36146] RE: [mg36124] RE: [mg36093] rectangle intersection
I made a small change to my solution using Throw and Catch to stop a
test early (no difference in timings) and tested David Park's solution
alongside mine. I had a little trouble making my rectangles come out
the same as his, but I managed. (Primarily, I had to change the sign of
one of my side lengths.) I did keep formatting changes out of the
Timings. I exhaustively tested that our answers agree, but I'm not
showing that here.
Dave's code is unchanged, so you can get it from his post below mine.
Needs["Graphics`Colors`"]
ClearAll[cis, rect, pickRect, extent, cannotIntersect, intersects,
daveRect]
cis[t_] := {Cos@t, Sin@t}
rect[{pt : {_, _}, angle_, {len1_, len2_}}] := Module[{pt2},
{pt, pt2 =
pt + len1 cis[angle],
pt2 - len2 cis[angle - Pi/2], pt - len2 cis[angle - Pi/2]}]
daveRect := {{Random[], Random[]}, Random[] + Pi/2, {Random[],
Random[]}}
pickRect := rect@daveRect
extent[r1_, r2_] := {Min@#, Max@#} & /@
((Take[r1, 2] - r1[[{2, 3}]]).Transpose@r2)
cannotIntersect[{{min1_, max1_}, {min2_,
max2_}}] := max2 < min1 || min2 > max1
intersects[r1_, r2_] := Catch[
If[cannotIntersect[#], Throw[False]] & /@
Flatten[Transpose[Outer[extent, \
{r1}, {r1, r2}, 1]~Join~Outer[extent, {r2}, {r2, r1}, 1], {1, 3, 2}],
1];
Throw[True]]
d1 = daveRect; d2 = daveRect;
r1 = rect@d1; r2 = rect@d2;
{intersects[r1, r2], RectangleIntersection[d1, d2]}
Show[Graphics[{{Blue, Polygon@r1}, {Red, Polygon@
r2}}], AspectRatio -> Automatic];
PlotRectangles[d1, d2];
davePairs = {daveRect, daveRect} & /@ Range[10000];
rectanglePairs = Map[rect, davePairs, {2}];
Timing[intersects[Sequence @@ #] & /@ rectanglePairs;]
Timing[RectangleIntersection[Sequence @@ #] & /@ davePairs;]
{3.266 Second, Null}
{26.187 Second, Null}
Bobby Treat
-----Original Message-----
From: David Park [mailto:djmp at earthlink.net]
To: mathgroup at smc.vnet.net
Subject: [mg36146] [mg36124] RE: [mg36093] rectangle intersection
Frank,
Perhaps the best method is to use the Developer`InequalityInstance
routine
that comes with Version 4.1.
I will represent a rectangle by the position of the lower left hand
corner,
the angle, theta, that the base makes with the x-axis and the lengths of
the
base and side of the rectangle. If base and side are vectors that lie
along
the base and side then a point in the rectangle is given by
{x, y} == corner + u base + v side where
0 < u < 1 and 0 < v < 1.
We can then solve for u and v in terms of x and y. For two rectangles, x
and
y must be the same and we can write inequalties for u[1], v[1], u[2] and
v[2] in terms of x and y. InequalityInstance will then either find a
point
that satisfies the inequalities or return {} if there are no points.
Here is a routine that returns True if the rectangles intersect and
False if
they don't. The information for each rectangle is entered as:
{{x0,y0}, theta, {baselength, sidelength}}
RectangleIntersection[r1_, r2_] :=
Module[{corner, u, v, base, side, lbase, lside, \[Theta], x, y, eqns,
sols},
{corner[1], \[Theta][1], {lbase[1], lside[1]}} = r1;
{corner[2], \[Theta][2], {lbase[2], lside[2]}} = r2;
base[1] = lbase[1]{Cos[\[Theta][1]], Sin[\[Theta][1]]};
side[1] = lside[1]{-Sin[\[Theta][1]], Cos[\[Theta][1]]};
base[2] = lbase[2]{Cos[\[Theta][2]], Sin[\[Theta][2]]};
side[2] = lside[2]{-Sin[\[Theta][2]], Cos[\[Theta][2]]};
eqns[1] = {x, y} == corner[1] + u[1]base[1] + v[1]side[1] // Thread;
eqns[2] = {x, y} == corner[2] + u[2]base[2] + v[2]side[2] // Thread;
sols[1] = Solve[eqns[1], {u[1], v[1]}];
sols[2] = Solve[eqns[2], {u[2], v[2]}];
eqns[3] =
Flatten[{0 < u[1] < 1, 0 < v[1] < 1, 0 < u[2] < 1, 0 < v[2] < 1}
/.
sols[1] /. sols[2]];
Developer`InequalityInstance[eqns[3], {x, y}] =!= {}
]
Here is a routine that draws the two rectangles:
PlotRectangles[r1_, r2_] :=
Module[{corner, base, side, \[Theta], lbase, lside},
{corner[1], \[Theta][1], {lbase[1], lside[1]}} = r1;
{corner[2], \[Theta][2], {lbase[2], lside[2]}} = r2;
base[1] = lbase[1]{Cos[\[Theta][1]], Sin[\[Theta][1]]};
side[1] = lside[1]{-Sin[\[Theta][1]], Cos[\[Theta][1]]};
base[2] = lbase[2]{Cos[\[Theta][2]], Sin[\[Theta][2]]};
side[2] = lside[2]{-Sin[\[Theta][2]], Cos[\[Theta][2]]};
Show[Graphics[
{Line[{corner[1], corner[1] + base[1], corner[1] + base[1] +
side[1],
corner[1] + side[1], corner[1]}],
RGBColor[0, 0, 1],
Line[{corner[2], corner[2] + base[2], corner[2] + base[2] +
side[2],
corner[2] + side[2], corner[2]}]}], AspectRatio ->
Automatic,
PlotRange -> All]
]
Here are some test cases.
rectangle[1] = {{0, 0}, 0°, {1, 1}};
rectangle[2] = {{1/2, 1/2}, 0°, {1, 1}};
PlotRectangles[rectangle[1], rectangle[2]];
RectangleIntersection[rectangle[1], rectangle[2]]
True
rectangle[1] = {{0, 0}, 0°, {1, 1}};
rectangle[2] = {{1.1, 1.1}, 0°, {1, 1}};
PlotRectangles[rectangle[1], rectangle[2]];
RectangleIntersection[rectangle[1], rectangle[2]]
False
rectangle[1] = {{0, 0}, 0°, {1, 1}};
rectangle[2] = {{1, 1}0.9, 45°, {2, 1}};
PlotRectangles[rectangle[1], rectangle[2]];
RectangleIntersection[rectangle[1], rectangle[2]]
True
For timing on an 800 Mhz machine..
rectangle[1] = {{0, 0}, 0°, {1, 1}};
rectangle[2] = {{1, 1}0.9, 45°, {2, 1}};
Do[RectangleIntersection[rectangle[1], rectangle[2]], {100}] // Timing
{0.66 Second, Null}
I don't know if that is fast enough.
David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/
From: Frank Brand [mailto:frank.brand at t-online.de]
To: mathgroup at smc.vnet.net
Dear colleagues,
any hints on how to implement a very fast routine in Mathematica for
testing if two rectangles have an intersection area?
Thanks in advance
Frank Brand