Additional Lighting and Clipping in LiveGraphics3D

Universität Gesamthochschule Kassel

Since 1997 Martin Kraus from Stuttgart develops * LiveGraphics3D*. This is a

In his well written

In some situations the color of the wrong face of a polygon is used. The reason is the simple (but fast) algorithm being used to decide which face is painted."

Two years ago I worked with

Don`t be alarmed that seven packages will be loaded now. Further on working with this notebook will become easier with these packages. Some hints about installation are given below. Only ExtendGraphics`Geometry3D` and LiveGraphics3D are not part of the standard *Mathematica* packages.

```
Off[ General :: spell ];Off[ General :: spell1 ];
Needs[ ExtendGraphics`Geometry3D` ]; Needs[ Graphics`Animation` ];
Needs[ Graphics`Colors` ]; Needs[ Graphics`ParametricPlot3D` ];
Needs[ Graphics`Polyhedra` ]; Needs[ Graphics`Shapes` ]; Needs[ LiveGraphics3D` ];
$DefaultFont = {Times, 12};
```

Area::shdw: Symbol Area appears in multiple contexts {Geometry`Polytopes`,ExtendGraphics`Geometry`}; definitions in context Geometry`Polytopes` may shadow or be shadowed by other definitions.

Take an icosahedron to get an impression of the problem of lighting "backward" faces of polygons and surfaces
with *LiveGraphics3D*.When you have loaded the package Graphics`Polyhedra`
you get an image of an icosahedron with the following expression:

`gr1 = Show[ Polyhedron[ Icosahedron ], Boxed -> False ];`

WriteLiveForm of *LiveGraphics3D* will produce the HTML-file. But you will see "shadows" on the backward faces.

```
WriteLiveForm[ "klafu1.m", gr1 ];
```

Now you can look at the result.

You may think that the wrong colors of the backward faces of the icosahedron may be due to the closed surface. But you get the same phenomenon with surfaces like the hyperbolic paraboloid with the simple equation *z* = *x y* .

`gr2 = Plot3D[ x y, {x,-2,2},{y,-2,2}, Axes -> None, PlotPoints -> 7 ];`

```
WriteLiveForm[ "klafu2.m", gr2 ];
```

Now the LiveGraphics3D-version.

There are several possibilities in *Mathematica* to restrict values of functions or parts of the domain of definition, e.g. in the image gr2:

`a = 1.5; gr3 = Plot3D[ x y, {x,-2,2}, {y,-2,2}, PlotPoints -> 7, PlotRange -> {-a,a} ];`

A little change and a restriction of the plot domain produce a more agreeable image:

`Plot3D[ x y, {x,-2,2}, {y,-2,2}, PlotPoints -> 7, PlotRange -> {{-a,a}, {-a,a}, {-a,a}} ];`

Axes -> None will suppress the ticks at the box. They are not needed for the transformation with *LiveGraphics3D* .

```
gr4 = Plot3D[ x y, {x,-2,2}, {y,-2,2}, PlotPoints -> 7, Axes -> None,
PlotRange -> {{-a,a}, {-a,a}, {-a,a}} ];
```

`WriteLiveForm[ "klafu3.m", gr3 ]; WriteLiveForm[ "klafu4.m", gr4 ];`

In every case *LiveGraphics3D* does not produce the desired result: klafu3.html , klafu4.html

I think that the following *Mathematica* figure will be adequate:

`gr5 = Show[ Graphics3D[ gr2 ], PlotRange -> {-a,a} ];`

Also transforming this figure with *LiveGraphics3D* gives not the desired
result:

`WriteLiveForm[ "klafu5.m", gr5 ];`

To switch on some "additional lights" gives an obvious solution. You will find some information about the option LightSources in the *Mathematica* Help-Browser. This option will be used in the next expressions. More information can be found in [Smith, Blachman, p. 254], [Wickham-Jones, p. 213] and [Schaper, p. 189] .

You can get information on the default LightSources:

```
Options[ Plot3D, LightSources ]
{LightSources -> {{{1.,0.,1.}, RGBColor[1,0,0]},
{{1.,1.,1.}, RGBColor[0,1,0]},
{{0.,1.,1.}, RGBColor[0,0,1]}}}
```

LightSources -> {*direction*,
* color*} produces parallel light with the direction *direction* and with the color *color*.

Now additional lightsources are used:

```
lights = {{{ 1, 0, 1}, Red}, {{ 1, 1, 1}, Green}, {{0, 1, 1}, Blue} ,
(* additional: *)
{{-1, 0,-1}, Red}, {{-1,-1,-1}, Green}, {{0,-1,-1}, Blue} };
SetOptions[ Plot3D, LightSources -> lights ];
```

As above the hyperbolic paraboloid and the icosahedron are used to give some explanations.

`gr6 = Plot3D[ x y, {x,-2,2}, {y,-2,2}, Axes -> None, Boxed -> True, PlotPoints -> 7 ];`

Using an adequate choice of ViewPoint you can look at the surface from "below".

`Show[ gr6, ViewPoint -> {-2,0,-3} ];`

`WriteLiveForm[ "klafu6.m", gr6 ];`

Here you can look at the HTML-version. And all polygons are colored!

The icosahedron will be treated in an analogous manner :

`gr7 = Show[ Polyhedron[ Icosahedron ], LightSources -> lights, Boxed -> False ];`

`WriteLiveForm[ "klafu7.m", gr7 ];`

You can see the positive effect . Compare this example with the old one .

Again we will begin with the hyperbolic paraboloid. The image gr3 is reproduced as gr8a :

`gr8a = Graphics3D[ Plot3D[x y, {x,-2,2}, {y,-2,2}, Axes -> True, PlotPoints -> 7,PlotRange -> {-a,a}] ];`

Now the surface is clipped by Clip3D from the package ExtendGraphics`Geometry3D` of Tom Wickham-Jones:

```
gr8b = Fold[ Clip3D[#1,#2]&, gr8a, {Plane[{0,0,a}, {0,0,-1}], Plane[{0,0,-a},{0,0,1}]}];
gr8c = Show[ gr8b, Axes -> True ];
```

The option Axes will get the value None:

`gr8 = Show[ gr8c, Axes -> None ];`

`WriteLiveForm[ "klafu8.m", gr8 ];`

As you can see *LiveGraphics3D *and the clipping work together. Since above the option LightSources of Plot3D has been changed also the backward faces are colored. You get the same effect with the icosahedron. Now different colors for the lightsourses are chosen.

```
gr9 = Show[ Polyhedron[ Icosahedron ], LightSources -> {{{1,0,1}, Red}, {{1,1,1}, Green}, {{0,1,1}, Blue},
{{-1,0,-1}, Tomato}, {{0,-1,-1}, SkyBlueDeep}, {{-1,-1,-1}, GreenDark} }, Boxed -> False ];
```

```
a = 3/4; gr10 = Fold[ Clip3D[#1,#2]&, gr9, {Plane[{0,0,a},{0,0,-1}], Plane[{0,0,-a},{0,0,1}]} ];
Show[ gr10 ];
```

`WriteLiveForm[ "klafu10.m", gr10 ];`

Here you get the WWW images .

**Klein Bottle**

At the beginning three different forms of the Klein bottle are clipped. In the *Mathematica*-Book [1999] you will find the first form on page 995 resp. in the Help Browser
at Light_Source_Varations. [Schaper, S. 257, ff.] gives parametrisations of the first and second form. You can get the parametrisations of the second and third form in from this page .
If you go to "Klein Bottle Formula" in the Help Browser of *Mathematica* gives supplementary information on the second form. Also see [Gray, p. 327].

(Inserted in September 2001: The parametrisation of the second form can be found in Dieudonné on page 192 resp. Seite 194. See also: The *Mathematica* Journal, 1, (3), 1991, p. 65.)

(Inserted in November 2002: See also the Klein Bottle page of MathWorld.)

```
bx = 6 Cos[u] (1 + Sin[u]); by = 16 Sin[u]; rad = 4 - 2 Cos[u];
X = If[ Pi < u <= 2 Pi, bx + rad Cos[v + Pi], bx + rad Cos[u] Cos[v]];
Y = If[ Pi < u <= 2 Pi, by, by + rad Sin[u] Cos[v]];
Z = rad Sin[v];
SetOptions[ ParametricPlot3D, LightSources -> lights ];
```

```
gr11 = ParametricPlot3D[{X,Y,Z}, {u,0,2 Pi}, {v,0,2 Pi}, PlotPoints -> {48,12}, Axes -> False,
Boxed -> False, ViewPoint -> {0,-2,-2}];
```

```
WriteLiveForm[ "klafu11.m", gr11 ];
```

klafu11.html

If *v* is in [0, Pi] you get this "insight":

```
gr12 = ParametricPlot3D[ {X,Y,Z},{u,0,2Pi},{v,0,Pi},
PlotPoints -> {48,12}, Axes -> False, Boxed -> False,
ViewPoint -> {0,-2,-2}];
```

```
WriteLiveForm[ "klafu12.m", gr12 ];
```

klafu12.html

Now another clipping:

```
gr13 = Fold[ Clip3D[#1,#2]&, gr11, {Plane[{0,-10,-1},{4,0,-1}]}];
Show[ gr13, ViewPoint -> {-1.5,0,0} ];
```

```
WriteLiveForm[ "klafu13.m", gr13 ];
```

klafu13.html

```
X = (2 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2v]) Cos[u];
Y = (2 + Cos[u/2] Sin[v] - Sin[u/2] Sin[2v]) Sin[u];
Z = Sin[u/2] Sin[v] + Cos[u/2] Sin[2v];
```

```
gr14 = ParametricPlot3D[ {X,Y,Z},{u,0,2 Pi},{v,0,2 Pi},
PlotPoints -> 51, Boxed -> False, Axes -> None ];
```

```
WriteLiveForm[ "klafu14.m", gr14 ];
```

klafu14.html

Now the clipping with two planes:

```
gr15a = Fold[ Clip3D[#1,#2]&, gr14,
{Plane[{0.5,0,0.4}, {-0.5,0.25,-1}], Plane[{0,00.8}, { 0, 0,-1}]}];
gr15 = Show[ gr15a ];
```

```
WriteLiveForm[ "klafu15.m", gr15 ];
```

klafu15.html

A polynomial representation of the Klein bottle due to Ian Stewart can be found on this web page . "The equation looks odd":

(x^2+y^2+z^2+2*y-1)*((x^2+y^2+z^2-2*y-1)^2-8*z^2)+16*x*z*(x^2+y^2+z^2-2*y-1) == 0

You can get the following part of the Klein bottle with the package ImplicitPlot3D and the following *Mathematica* expression.

A
t t e n t i o n p l e a s e : The computation needs a lot of time!

```
(* h = 7; p = 51;
gr16 = ImplicitPlot3D[
(x^2+y^2+z^2+2*y-1)*((x^2+y^2+z^2-2*y-1)^2-8*z^2)+16*x*z*(x^2+y^2+z^2-2*y-1) == 0,
{x,-2,h},{y,-2,h}, {z,-2,h}, PlotPoints -> {p,p,p},
ViewPoint -> {-3,0,1}, Boxed -> False, LightSources -> lights] ;
*)
```

```
(* WriteLiveForm[ "klafu16.m", gr16 ]; *)
```

klafu16.html

```
(* gr17 = Fold[ Clip3D[#1,#2]&, gr16, {Plane[{-1,-1.5,3}, {3,-2,-2}]}];
gr18 = Show[ gr17 , Boxed -> False ];
*)
```

```
(* WriteLiveForm[ "klafu18.m", gr18 ]; *)
```

klafu18.html

At MathSource there is a notebook of Andrew J. Hanson: FermatSolution.nb .

"Solution of Fermat's Equation + = 1

The notebook shows a projection from four-dimensional space of the so-called projective variety that represents all possible solutions of the equation + == for varying *n*. What Fermat's Last Theorem states is that none of these solutions can correspond to integer values of *x*, *y* and *z*. "

Look also at the figures on page 39 of the second edition of the *Mathematica*-Book. Having done some calculations not incoorperated in this notebook, it is possible to work with the following expressions:

```
(* gr19 = Show[ Graphics3D[ Table[surface[k1, k2], {k1,1,n}, {k2,1,n}]],
Boxed -> False, LightSources -> lights ];
*)
```

```
(* WriteLiveForm["klafu19.m", gr19]; *)
```

klafu19.html

You will get more "insight" after clipping:

```
(* a = 0.2;
gr20 = Fold[ Clip3D[#1,#2]&, gr19, {Plane[{a,a,a}, {-1,1,-1}] }];
gr21 = Show[ gr20, PlotRange -> All ];
*)
```

```
(* WriteLiveForm[ "klafu21.m", gr21 ]; *)
```

klafu21.html

Some years ago I explored the following surface. At the first glance it seems to be boaring. But there are "inner values" which can be seen when the graphic is rendered or after an adequate clipping. The changed options of lightsources are used.

`SetOptions[ Graphics3D, Boxed->False ];`

```
gr22a = ParametricPlot3D[{u Cos[v] Sin[u], u Cos[u] Cos[v],-u Sin[v] },
{u, 0, 3Pi, Pi/18}, {v, 0, 2Pi, Pi/18}, Boxed -> False, Axes -> False ];
```

Remembering abraded shells on the shore I took the following choice of PlotRange:

`gr22b = Show[ gr22a, PlotRange -> {All,{-0.5,10},All} ];`

```
gr22c = Fold[ Clip3D[#1,#2]&, gr22a,{Plane[{0,-0.7,0.5}, {-0.2,1,-1.5}], Plane[{0,-0.5, 0}, { 0,1, 0}] }];
gr22 = Show[ gr22c ];
```

```
WriteLiveForm[ "klafu22.m", gr22 ];
```

klafu22.html

I think that Michael Trott is the author of the following *Mathematica*-Oneliner.
SetOptions[ Graphics3D, Boxed -> False ] is needed:

```
gr23a = With[ {stelldode = Stellate@Delete[Dodecahedron[1.6]}
Show@ Graphics3D@{EdgeForm@Thickness@0.001,
Stellate[OpenTruncate@Geodesate[stellDode, 3, {0,0,0},1.6], 1.05],
Stellate@OpenTruncate@Geodesate[stellDode, 3]}];
```

Clipping and lighting is applied to this object:

```
gr23b = Fold[ Clip3D[#1,#2]&,gr23a,
{Plane[{0,0.15,0}, {0,-1, 0}], Plane[{0,-0.15,0}, {0,1,0}]}];
gr23 = Show[ gr23b, Boxed -> False,PlotRange -> All, ViewPoint -> {0,-3,0},LightSources -> lights ];
```

```
WriteLiveForm[ "klafu23.m", gr23 ];
```

klafu23.html

Now the hole is filled:

```
Needs[ "Graphics`Shapes`" ]; gr24a = Graphics3D[ Sphere[0.98,32,16] ];
Show[ gr24a ];
```

There is a remark on "placing several lightsources at the same point" in [ Smith, Blachman, p.260]. That will produce "more intense illumination".

```
gr25 = Show[ {gr23,gr24a}, Boxed -> False,
ViewPoint -> {0,-3,0}, LightSources ->
{{{1,0,1}, Gold}, {{0,1,1}, Gold}, {{1,1,1}, Yellow},
{{1,1,1}, Red},{{1,0,1}, Gold}, {{0,1,1}, Gold}, {{1,1,1}, Gold},
{{-1, 0,-1}, Yellow}, {{ 0,-1,-1}, Yellow},
{{-1,-1,-1}, Yellow}, {{-1,-1,-1}, Red}}];
```

```
WriteLiveForm[ "klafu25.m", gr25 ];
```

klafu25.html

Let the sun shine bright over the conferences at Klagenfurt.

You have to set the right path in the package LiveGraphics3D` to save the HTML-files.

In his book Tom Wickham-Jones describes a *Mathematica*-package for additional clipping routines of 3D-graphics.

You can get the packages on *MathSource* with this URL:

http://www.mathsource.com/Content/Enhancements/Graphics/3D/0208-976

Our notebook needs only the packages Geometry.m, Geometry3D.m, NonConvexTriangulate.m and SimpleHull.m . Work will be more easy if the mentioned files are loaded in a directory also named ExtendGraphics in the directory Autoload in AddOns:

E.g.: Mathematica/4.1/AddOns/Autoload/ExtendGraphics.

You can find the following example in the book of Wickham-Jones ( p. 440 ). You may proceed in the following manner after loading the mentioned packages:

```
Needs[ "ExtendGraphics`Geometry3D`" ]
surf = Graphics3D[ Plot3D[Sin[x y], {x,-Pi,Pi}, {y,-Pi,Pi}, PlotPoints- > 30 ]];
```

`?Plane`

Plane[ c, n] represents the plane line which passes through c and is normal to n.

```
gr26a = Fold[ Clip3D[#1,#2]&, surf, {Plane[{0,0,0.5},{0,0,-1}], Plane[{0,0,-0.5}, {0,0,1}]}];
Show[ gr26a ];
```

End of the citation.

`gr26 = Show[ gr26a, Boxed -> False, Axes -> None, DisplayFunction -> Identity ];`

```
WriteLiveForm[ "klafu26.m", gr26 ];
```

klafu26.html

At last a variation with a "sloping" plane:

```
gr27a = Fold[ Clip3D[#1,#2]&, surf, {Plane[{Pi/2,0,0}, {-1,1,-1}]}];
gr27 = Show[ gr27a, Boxed -> False, Axes -> None ];
```

```
WriteLiveForm[ "klafu27.m", gr27 ];
```

klafu27.html

Jean Dieudonné: Treatise on Analysis, volume III

New York: Academic Press, 1972

Jean Dieudonné: Grundzüge der modernen Analysis, Band 3

Braunschweig: Vieweg, 1976

Alfred Gray: Modern Differential Geometry of Curves and Surfaces with *Mathematica*

Boca Raton: CRC Press, 1998, 0-8493-7164-3

Ralf Schaper: Grafik mit *Mathematica*

Bonn: Addison-Wesley, 1994, 3-89319-612-9

Cameron Smith, Nancy Blachman: The *Mathematica* Graphics Guidebook

Reading: Addison Wesley, 1995, 0-201-53280-8

Tom Wickham-Jones: *Mathematica* Graphics

New York: Springer, 1994, 0-387-94047-2

Stephen Wolfram: The *Mathematica *Book, 2nd ed.

Redwood City: Addison-Wesley, 1991, 0-201-51502-4

Stephen Wolfram: The *Mathematica* Book, 4th ed.

Champaign: Wolfram Media, 1999, 1-57955-004-5

Fermat ImplicitPlot3D Klein Bottle

HomePage Documentation Examples Two Surfaces Polyhedron Explorer Uniform Polyhedra