RE: Mysterious 3-way Collision of Polygons

*To*: mathgroup at smc.vnet.net*Subject*: [mg32367] RE: [mg32327] Mysterious 3-way Collision of Polygons*From*: "David Park" <djmp at earthlink.net>*Date*: Wed, 16 Jan 2002 03:30:40 -0500 (EST)*Sender*: owner-wri-mathgroup at wolfram.com

Hartmut, I believe that this is a bug in Mathematica's 3D rendering algorithm and there is not a lot that you can do about it. The workarounds may turn out to have narrow scope. I discussed similar problems in the thread... http://library.wolfram.com/mathgroup/archive/2001/Aug/msg00029.html I was doing an animation and sometimes lines would appear and disappear. Sometimes color directives would be used and then not used. I even got an effect where a color directive for a line in the plot would get transferred to half, but not all, of the lines in the boxed frame. This happened in some frames and not other frames. These things clearly have to do with the overall rendering algorithm. I believe that WRI is well aware of these problems and I believe they are making a major push on graphics for future versions. When these might be available I don't know. With a little bit of luck we might get something good. In the meantime I would recommend patience and, of course, everybody should cross their fingers and toes. David Park djmp at earthlink.net http://home.earthlink.net/~djmp/ > From: Wolf, Hartmut [mailto:Hartmut.Wolf at t-systems.de] To: mathgroup at smc.vnet.net > > > 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 > >

**Follow-Ups**:**Re: Mysterious 3-way Collision of Polygons***From:*John Fultz <jfultz@wolfram.com>