MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Mysterious 3-way Collision of Polygons


Hi,

the simple answer is, send the graphics to MathGL3d and get it
back. MathGL3d looks for degeneration in polygons and remove it.
In your example

Get["MathGL3d`OpenGLViewer`"] 

g = Show[g1, g2, g3, Boxed -> False];

MVShow3D[g, MVNewScene -> True];

Show[MVGetGraphics3D[]]

will fix the problem and

FullForm[MVGetGraphics3D[]]

gives

Graphics3D[
  List[List[
      Polygon[List[List[2.`, 1.1111111111111112`, 2.`], 
          List[2.`, 2.`, 2.888888888888889`], 
          List[1.`, 1.9999999999999998`, 2.`]]], 
      Polygon[List[List[1.`, 1.9999999999999998`, 2.`], 
          List[2.`, 2.888888888888889`, 2.`], 
          List[2.`, 2.`, 1.1111111111111112`]]], 
      Polygon[List[List[1.`, 1.9999999999999998`, 2.`], 
          List[2.`, 2.`, 1.1111111111111112`], 
          List[2.`, 1.1111111111111112`, 2.`]]]]]]

The graphics is also shown correct with the RealTime3D` package
and

<< RealTime3D`
Show[g, RenderAll -> False]

will just show you the graphics.

Regards
  Jens



"Wolf, Hartmut" wrote:
> 
> 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


  • Prev by Date: Re: RE: Runs on a Ring
  • Next by Date: RE: Mysterious 3-way Collision of Polygons
  • Previous by thread: Mysterious 3-way Collision of Polygons
  • Next by thread: RE: Mysterious 3-way Collision of Polygons