Mysterious 3-way Collision of Polygons
- To: mathgroup at smc.vnet.net
- Subject: [mg32327] Mysterious 3-way Collision of Polygons
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.de>
- Date: Tue, 15 Jan 2002 02:30:03 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
I'm trying to write a graphics routine which is to be fast as well as
robust. However I've met a serious obstacle doing so.
These are three Polygons that came out from the routine (among others):
poly1 = Polygon[{{1., 1.9999999999999998, 2.},
{1., 2., 1.9999999999999998},
{2., 2., 1.1111111111111112},
{2., 1.1111111111111112, 2.}}];
poly2 = Polygon[{{1., 2., 1.9999999999999998},
{1., 2., 2.},
{2., 2.888888888888889, 2.},
{2., 2., 1.1111111111111112}}];
poly3 = Polygon[{{2., 1.1111111111111112, 2.},
{2., 2., 2.888888888888889},
{1., 2., 2.},
{1., 1.9999999999999998, 2.}}];
They are nearly degenerate, as for each of those, two defining points have
come very close, be that accidentally or caused by numerical imprecision. We
might expect problems with display, however each one shows nicely (and of
course they look like triangles):
g1 = Show[Graphics3D[poly1]];
g2 = Show[Graphics3D[poly2]];
g3 = Show[Graphics3D[poly3]];
They also combine in pairs:
Show[g1, g2, Axes -> True];
Show[g2, g3, Axes -> True];
Show[g1, g3, Axes -> True];
But not all three together:
g = Show[g1, g2, g3, Boxed -> False];
Just plain nothing.
Surprisingly, if we make them fully degenerate, e.g. this way:
Map[Rationalize, g, {4}] // InputForm
Graphics3D[{Polygon[{{1, 2, 2}, {1, 2, 2}, {2, 2, 10/9}, {2, 10/9, 2}}],
Polygon[{{1, 2, 2}, {1, 2, 2}, {2, 26/9, 2}, {2, 2, 10/9}}],
Polygon[{{2, 10/9, 2}, {2, 2, 26/9}, {1, 2, 2}, {1, 2, 2}}]},
{Boxed -> False}]
Show[%, Boxed -> True, Axes -> True];
Show[%, ViewPoint -> {4., -1., 1.5}];
>From this perspective we see the polygons touch and meet in a single vertex.
This is exactly what should be.
Rationalizing however is too expensive an operation to be used on many
thousands of polygons. Rounding is much cheaper, but to which "grid
constant", which coarseness?
Cases[{#, With[{d = #*10.^-$MachinePrecision},
Subtract @@ Round[d^-1 * {1.9999999999999998, 2.}]*d]} & /@
N[Range[1, 10000]],
{n_, s_ /; UnsameQ[s, 0]} :> n]
{1., 2., 3., 4., 5., 6., 7., 12., 14., 15., 31., 41., 43., 44., 58., 63.,
68., 89., 94., 204., 223., 358., 361., 396., 748., 815., 876., 1101., 1212.,
1553., 1644., 3212., 4341., 4659., 6135., 6732., 7115., 7335., 9636.}
Show[Map[With[{d = 8.*10.^-$MachinePrecision}, d*Round[d^-1*#]] &, g, {4}],
Boxed -> True];
works!
Show[Map[With[{d = 9636.*10.^-$MachinePrecision}, d*Round[d^-1*#]] &, g,
{4}],
Boxed -> True];
doesn't !
(With Boxed -> True, we now see a diagonal line, the ruins of the box?) Lets
be more specific and ask how much shall we have to dislocate one of the
nearly coinciding points to get a "decent" display. The answer is surprising
(to me at least):
Show[GraphicsArray[Partition[
With[{\[Epsilon]=10.^-#},Graphics3D[
{Polygon[{{1., 2.-\[Epsilon], 2.},
{1., 2., 2.-\[Epsilon]}, {2., 2., 1.1111111111111112},
{2., 1.1111111111111112, 2.}}],
Polygon[{{1., 2., 2.-\[Epsilon]}, {1., 2., 2.},
{2., 2.888888888888889, 2.}, {2., 2., 1.1111111111111112}}],
Polygon[{{2., 1.1111111111111112, 2.}, {2., 2., 2.888888888888889},
{1., 2., 2.}, {1., 2.-\[Epsilon], 2.}}]},
{Axes -> True,
PlotLabel->StyleForm[" "<>ToString[\[Epsilon]]<>" ",
Background->Hue[0.3,0.5,1]]}
]]& /@ Range[16,1,-1],
3,3,{1,1},{}]]];
Except for the first Graph (at exact coincidence of two points), nothing,
even at macroscopic level is acceptable. (Perhaps you might want to have a
closer look at the last but one, the clue might be there, but I have no idea
what happens.) We compare the last graphic with the first one.
{gok, gepsilon} = {%[[1, 1, 1]], %[[1, -1, 1]]};
Show[GraphicsArray[%]];
Show[Map[Append[#, ViewPoint -> {4., -1., 1.5}] &, %, {2}]];
The supposed to be tetragons have become pentagons and hexagons.
Watched individually, they look differently and just what they should to be.
Show[GraphicsArray[
Graphics3D[#, ViewPoint -> {4., -1., 1.5}] & /@
gepsilon[[1, {1, 2, 3}]]]];
How may I deal with this problem?
--
Hartmut Wolf