Mathematica Graphics in the Internet:
Additional Lighting and Clipping in LiveGraphics3D

Ralf Schaper
Universität Gesamthochschule Kassel

Juli 2001 (version 2: September 2001, version 3: November 2002)

Introduction

Since 1997 Martin Kraus from Stuttgart develops LiveGraphics3D. This is a Java 1.1-Applet to display and to rotate three-dimensional graphics in HTML pages produced by Mathematica. The project is supported by Wolfram Research (see also the index of interactive illustrations). There is also a short user manual.
In his well written documentation Martin Kraus mentions two restrictions:
"LiveGraphics3D does not clip primitives which are outside of the PlotRange.                                               
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 LiveGraphics3D and I found some solutions. Now at last I will give a short description. Additional  information and the Mathematica-notebook you may get from this page.

Initialization

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.

Problem 1: Lighting

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.

Problem 2: Clipping

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 ];

klafu5.html

A solution of problem 1 : Lighting

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 .

A solution of problem 2 : Clipping

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 .

Applications

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.)

First form:

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

Second form:

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

Third form:

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

Fermat

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

Outlook

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.

Hints for the Installation

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

Sources

Books

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

URLs

Fermat    ImplicitPlot3D    Klein Bottle

LiveGraphics3D

HomePage   Documentation    Examples   Two Surfaces   Polyhedron Explorer   Uniform Polyhedra