Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2002

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

Search the Archive

Re: Mysterious 3-way Collision of Polygons

  • To: mathgroup at smc.vnet.net
  • Subject: [mg32344] Re: Mysterious 3-way Collision of Polygons
  • From: Jens-Peer Kuska <kuska at informatik.uni-leipzig.de>
  • Date: Wed, 16 Jan 2002 03:29:51 -0500 (EST)
  • Organization: Universitaet Leipzig
  • References: <a20m9t$4ga$1@smc.vnet.net>
  • Reply-to: kuska at informatik.uni-leipzig.de
  • Sender: owner-wri-mathgroup at wolfram.com

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