On this page you will find some tessellations, surfaces, and other math stuff along with some basic Mathematica code. See also my my page at the Virtual Art Museum and The Math Book by Clifford Pickover.
Dodecaplex (120 Cell) - Mathematica 4.2, POV-Ray 3.6.1, 10/21/08
Polychorons are the 4D version of polyhedrons (in general, for arbitrary dimensions, these are called polytopes). A dodecaplex is a uniform polychoron composed 120 dodecahedral cells. These cells can be divided into 12 rings (Hopf fibrations) of 10 cells each. One way to visualize a polychoron is to apply a 4D to 3D stereographic projection to it. The left picture shows a stereographic projection of the complete dodecaplex. The right picture shows 6 of the inner rings (each ring is shown in a different color), but only 5 rings are open to direct view because they are wrapped around the 6th ring. I first saw this concept on Matthias Weber's book page. Click here to download some POV-Ray code.Links Flatland - movie based on Edwin Abbott's novel Jenn 3D - polytope program that uses the Todd-Coxeter algorithm, by Fritz Obermeyer The HyperSphere, from an Artistic point of View - explanation by Rebecca Frankel 120 Cell Soap Bubbles - by John Sullivan Regular Polytopes - Mathematica notebook by Russell Towle POV-Ray include files - by Russell Towle Magic 120 Cell - OpenGL program by Roice Nelson, et al. |
Knotted Surface - AutoCAD 2000, POV-Ray 3.6.1, 4/24/07
This began as an attempt to animate a similar-looking structure to Bathsheba Grossman’s beautiful Quin Pendant Lamp. To create this image, first I sketched the basic curves for one arm in AutoCAD and then I assembled and rendered it in POV-Ray. Depending on your point of view, this knotted surface can be seen as a dodecahedron with a hole over each edge, or an icosahedron with a hole over each vertex, or an icosahedron with a hole over each edge, or a rhombic triacontahedron with a hole over each face. The left animation shows a homotopy that continuously maps the structure into a sphere with 30 holes. The boundary of each hole loops over itself twice and links with 6 others. Here is some Mathematica code:(* runtime: 0.1 second *) << Graphics`Shapes` ; alpha = ArcCos[-Sqrt[5]/5]; surface = {{{0.11, 0.35, 1}, {0.16, 0.33, 1}, {0.23, 0.35, 0.99}, {0.3, 0.38, 0.96}, {0.35, 0.43, 0.9}, {0.29, 0.42, 0.8}, {0.22, 0.37,0.7}, {0.14, 0.34, 0.62}, {0.078, 0.296, 0.585}}, {{0, 0, 1}, {0.13, 0.09, 1}, {0.29, 0.22, 0.99}, {0.4, 0.33, 0.95}, {0.41, 0.45, 0.88}, {0.31, 0.47, 0.77}, {0.2, 0.43, 0.65}, {0.08, 0.4, 0.56}, {-0.019, 0.398, 0.526}}, {{0.36, 0, 1}, {0.39, 0.11, 1}, {0.45, 0.23,0.99}, {0.49, 0.35, 0.95}, {0.47, 0.45, 0.86}, {0.36, 0.52, 0.73}, {0.22, 0.5, 0.59}, {0.13, 0.48, 0.48}, {0.07, 0.489, 0.437}}}; arm = Map[Polygon[Flatten[#, 1][[{1, 2, 4, 3}]]] &, Partition[surface, {2, 2}, 1], {2}]; face = Table[RotateShape[Graphics3D[arm], 0, 0, psi][[1]], {psi, 0, 1.6Pi, 0.4Pi}]; Show[Graphics3D[{face, RotateShape[face, 0, Pi, 0], Table[{RotateShape[face, 0, Pi - alpha, psi + Pi/5], RotateShape[face, Pi/5, alpha, psi]}, {psi, 0, 1.6Pi, 0.4Pi}]}]] Links Quin Pendant Lamp - a very beautiful lamp by Bathsheba Grossman Topmod Dodecahedron - a beautiful structure created by Jotero using TopMod3d TopMod3d - free topological mesh modeling software Metal Printed Quintrino - by Bathsheba Grossman SeifertView - free program for creating knotted surfaces, by Jarke van Wijk and Arjeh Cohen |
Clifford Torus - Mathematica 4.2, POV-Ray 3.6.1, 8/12/08
The Hopf map is a special transformation invented by Heinz Hopf that maps to each point on the ordinary 3D sphere from a unique circle of points on the 4D sphere. Taken together, these circles form a fiber bundle called a Hopf Fibration. If you apply a 4D to 3D stereographic projection to the Hopf Fibration, you get a beautiful 3D torus called a Clifford Torus composed of interlinked Villarceau circles. By applying 4D rotations to the Hopf Fibration, you can transform the Clifford Torus into a Dupin cyclide or you can turn it inside-out. As it turns out, there is a single point of rotation in 2D, there are 3 axes of rotation in 3D (x, y, z), and there are 6 planes of rotation in 4D (xy, xz, xw, yz, yw, zw). Click here to download some POV-Ray code. Here is some Mathematica code:(* runtime: 7 seconds *) HopfInverse[theta_, phi_, psi_] := {Cos[phi/2] Cos[psi], Cos[phi/2]Sin[psi], Cos[theta + psi]Sin[phi/2], Sin[theta + psi]Sin[phi/2]}; Ryw[theta_] := {{1, 0, 0, 0}, {0, Cos[theta], 0, Sin[theta]}, {0, 0, 1, 0}, {0, -Sin[theta], 0, Cos[theta]}}; StereographicProjection[{x_, y_, z_, w_}] := {x, y, z}/(1 - w); Table[Show[Graphics3D[Table[{Hue[(4 phi/Pi - 1)/3],Table[Line[Table[StereographicProjection[Ryw[alpha].HopfInverse[theta, phi, psi]], {psi, 0.0, 2Pi, Pi/18}]], {theta, 0.0, 2 Pi,Pi/9}]}, {phi, Pi/4, 3Pi/4, Pi/4}], PlotRange -> 3{{-1, 1}, {-1, 1}, {-1, 1}}]], {alpha, 0, Pi, Pi/18}]; Links Dimensions - interesting video animated by Jos Leys, see their fibration explantion and video The Flat Torus in 3-Sphere - by Thomas Banchoff, explanation1, explanation2, animations Stereographic Projection - by Davide Cervone Visualization of the Hopf Bundle - Mathematica notebook by Srdjan Vukmirovic Hyperspheres - If a 1-sphere is a circle, and a 2-sphere is a regular sphere, then what is a 3-sphere? How about a 4.5-sphere? Did you know there is a formula to find the “volume” for any n-sphere? |
Double Spiral - new version: C++, POV-Ray 3.6.1, 10/1/08; old version: Mathematica 4.2, 7/18/05
One way to create a double spiral is by applying a light projection from the top of a loxodrome onto a plane. This type of projection is called a stereographic projection. Click here to download a Mathematica notebook. Here is some Mathematica code:(* runtime: 3 seconds *) << Graphics`Shapes`; a = 0.25; Rx[phi_] := {{1, 0, 0}, {0, Cos[phi], -Sin[phi]}, {0, Sin[phi], Cos[phi]}}; Do[loxodrome = Table[Rx[phi].{Sin[t], -a t, -Cos[t]}/Sqrt[1 + (a t)^2], {t, -100, 100, 0.1}]; projection = Map[Module[{r = 2/(1 - #[[3]])}, {r #[[1]],r #[[2]], -1}] &, loxodrome]; Show[Graphics3D[{EdgeForm[], Sphere[0.99, 37, 19], Polygon[{{4, 4, -1}, {-4, 4, -1}, {-4, -4, -1}, {4, -4, -1}}],Line[loxodrome], Line[projection]},PlotRange -> {{-4, 4}, {-4, 4}, {-1, 1}}]], {phi, 0, Pi -Pi/12, Pi/12}] Another kind of double spiral can be made by applying a special homography to a single logarithmic spiral: (* runtime: 0.05 second *) Show[Graphics[Table[Line[Table[z = Exp[r + (2 r + theta)I]; z = (1 + z)/(1 - z); {Re[z], Im[z]}, {r, -10, 10, 0.1}]], {theta, -Pi, Pi, Pi/3}], PlotRange -> {{-2, 2}, {-2, 2}}, AspectRatio -> Automatic]] |
Here is some Mathematica code that uses the inverse method:(* runtime: 17 seconds *) Show[Graphics[RasterArray[Table[r1 = (x - 1)^2 + y^2; r2 = (x + 1)^2 + y^2; Hue[(Sign[y]ArcCos[(x^2 + y^2 - 1)/Sqrt[r1 r2]] -Log[r1/r2])/(2Pi)], {x, -2, 2, 4/274}, {y, -2, 2, 4/274}]], AspectRatio -> 1]] and here is some POV-Ray code: // runtime: 2 seconds camera{orthographic location <0,0,-2> look_at 0 angle 90} #declare r1=function(x,y) {(x-1)*(x-1)+y*y}; #declare r2=function(x,y) {(x+1)*(x+1)+y*y}; #declare f=function{(y/abs(y)*acos((x*x+y*y-1)/sqrt(r1(x,y)*r2(x,y)))-ln(r1(x,y)/r2(x,y)))/(2*pi)}; plane{z,0 pigment{function{f(x,y,0)}} finish{ambient 1}} Links other double spiral formulas - Cornu spiral (clothoid), tanh spiral Whirlpools - famous double spiral tessellation by M.C. Escher |
Boy’s Surface (Bryant-Kusner Parametrization) - new version: POV-Ray 3.6.1, 6/20/06
old version: Mathematica 4.2, MathGL3d, POV-Ray 3.6.1, 5/24/05
This one-sided surface was first parametrized correctly by Bernard Morin. The animation looks like it’s turning inside-out, although technically that’s impossible because it only has one side! Robert Bryant told me that the parameters (p,q) = (0,1) give this Willmore immersion of RP2 a trilateral symmetry. The parameters (p,q) = (1,0) should give bilateral symmetry. Click here to download some POV-Ray code for this image. Here is some Mathematica code:(* runtime: 1 second *) ParametricPlot3D[Module[{z = r E^(I theta), a, m}, a = z^6 + Sqrt[5]z^3 - 1; m = {Im[z(z^4 - 1)/a], Re[z(z^4 + 1)/a], Im[(2/3) (z^6 + 1)/a] + 0.5}; Append[m/(m.m), SurfaceColor[Hue[r]]]], {r, 0, 1}, {theta, -Pi, Pi}, PlotPoints -> {20, 72}, ViewPoint -> {0, 0, 1}] POV-Ray also has an internal function for a different parametrization: // runtime: 50 seconds camera{location -1.5*z look_at 0} light_source{-z,1} #declare f=function{internal(8)} isosurface{function{-f(x,y,z,1e-4,1)} pigment{rgb 1}} |
Another way to obtain other symmetries is to use conformal mapping.Links Rotatable 3D Boy’s Surface Steiner Surfaces - POV-Ray animations by Adam Coffman Möebius Strip - a simple one-sided surface, see these twisting and 5 fold animated Möebius strips by Jos Leys Klein Bottle - an enclosed Möebius strip Möebius strip to Klein bottle transformation - Mathematica code by Ari Lehtonen |
Breather Pseudosphere - new version: POV-Ray 3.6.1, 6/21/06
old version: Mathematica 4.2, MathGL3d, POV-Ray 3.6.1, 9/30/04
A sphere is an elliptic surface with constant positive curvature. A pseudosphere is a hyperbolic surface with constant negative curvature. This pseudosphere is called a Breather. The animation shows how the surface changes from Kuen's surface into a breather with many ribs when the parameter is changed. Click here to download some POV-Ray code for this image. This image was featured at the Mathema Exhibition at the German Technical Museum in Berlin and in the Spektrum der Wissenschaft magazine. Here is some Mathematica code:(* runtime: 6 seconds *) a = 0.498888; vmax = 47.1232; w = Sqrt[1 - a^2]; Breather[u_, v_] := Module[{d = a((w Cosh[a u])^2 + (a Sin[w v])^2)}, x = -u + 2w^2 Cosh[a u]Sinh[a u]/d; y = 2w Cosh[a u](-w Cos[v]Cos[w v] - Sin[v]Sin[w v])/d; z = 2w Cosh[a u](-w Sin[v]Cos[w v] +Cos[v]Sin[w v])/d; {x, y, z, {EdgeForm[], SurfaceColor[Hue[v/vmax]]}}]; ParametricPlot3D[Breather[u, v], {u, -10, 10}, {v, 0, vmax}, PlotPoints -> {49, 79}, Compiled -> False] Links Virtual Math Museum - beautiful rendition of this surface by Luc Benard, winning entry on cover of Science Magazine’s 2006 Visualization Challenge POV-Ray Code - by Mike Williams, param.inc Cooling Air Towers - also have a hyperbolic shape |
Hyperbolic Dodecahedron - POV-Ray 3.6.1, 2/15/07
A dodecahedron is a polyhedron with 12 pentagonal faces. This dodecahedron uses spheres for each face. Here is some POV-Ray code for the hyperbolic dodecahedron. See also my expanding dodecahedron.<< Graphics`Polyhedra`; Show[Graphics3D[Polyhedron[Dodecahedron][[1]]]] Links Ideal Hyperbolic Polyhedra - POV-Ray renderings by Matthias Weber Dodecahedral Machinery - by Ramiro Perez Spikey - Mathematica’s cover image dodecahedron Megaminx - dodecahedron-shaped Rubik's Cube Buckminsterfullerene (Buckyball) - truncated icosahedron arrangement of carbon atoms, assembly movie George Hart - polyhedra artist |
Inside the Hyperbolic Dodecahedron - POV-Ray 3.6.1, 2/15/07
This is what the dodecahedron would look like viewed from the inside with spherical mirrored walls. At certain dihedral angles, this resembles a Poincaré projection of 3D hyperbolic space tiled with dodecahedrons. Notice that when the space becomes elliptic, a black “hole” opens up in the center. This is because the space loops around on itself causing objects beyond the “maximum distance” to appear larger because they are actually closer. Weird huh?Links Hyperbolic Chamber - explantion and visuals Legos, by Jos Leys Curved Spaces 3 - program for tiling spherical and hyperbolic 3D space, by Jeff Weeks Hyperbolic Space Tiled by Dodecahedra - by Charlie Gunn |
Inside the Flat (Euclidean) Dodecahedron - POV-Ray 3.6.1, 2/12/07
Here is a dodecahedron viewed from the inside with flat mirrored walls.Links Mirrored Cube - this is what is might look like inside a 3-torus by Bernard Hatt, here is an older version |
(3,∞) Poincaré Hyperbolic Tiling - Mathematica 4.2, 3/17/05
The area inside this circle represents a hyperbolic plane filled with “ideal triangles”. Notice that all the angles inside these triangles go to zero at the edge of the circle. This image was generated using a series of reflections called anti-homographies. I learned about homographies while participating at the Experimental Geometry Lab at the University of Maryland. The right animation shows how a single homography can transform the upper half plane into the Poincaré disk. Here is some POV-Ray code to approximate this tiling as "hyperbolic kaleidoscope" using mirrors:// runtime: 2 seconds global_settings{max_trace_level 1000} #declare r=1/sqrt(3); #declare zcam=1e-5; #declare Abs=function(X,Y) {sqrt(X*X+Y*Y)}; camera{location <0,0,zcam> look_at <0,0,0> angle degrees(pi-2*atan(zcam/r))} plane{<0,0,1>,0 pigment{function{6*min(Abs(x,y+2*r),Abs(x-1,y-r),Abs(x+1,y-r))}} finish{ambient 1}} #declare mirror=sphere{<0,0,0>,1 scale <1,1,sqrt(2)>} union{object{mirror translate <0,-2*r,0>} object{mirror translate <1,r,0>} object{mirror translate <-1,r,0>} finish{reflection 1}} |
Technically, it is impossible to map a regular Euclidean tiling to the hyperbolic plane but it can still be done with some distortion. Jos Leys created these for me using my Dinosaur tessellation. The left image is a highly distorted (6,6) tiling and the right image is a (6,4) tiling.Hyperbolic Links hyperbolic animations - by Jos Leys Hyperbolic Java applet - by Don Hatch HypEngine - 3D real-time hyperbolic maze by Bernie Freidin Hyperbolic surfaces in nature - leaf edges and torn plastic sheets Ruffled or Lettuce Sea Slug - hyperbolic surface in nature Mathematica package - by Matthias Weber Mathematica code - for animated Poincaré grid, by Matthew Cook “Circle Limit III” and “Circle Limit IV” - M.C. Esher’s famous hyperbolic tessellations Reducing Lizards - upper half plane tessellation by M.C. Escher “Escher Fish” - Mathematica version by Silvio Levy Kangaroo Tiling - hyperbolic tessellation by Guy Cousineau, et. all |
Hyperbolic Texture Mapping - Mathematica 4.2 version: 6/22/05, C++ version: 8/9/05
This “hyperbolic beach ball” and hyperboloid were ray traced and textured using inverse transformations (the “pull back” method). Click here to download the complete Mathematica notebook for this image. Also, here is a C++ version for this image. |
(3,∞) Poincaré Hyperbolic Tiling - POV-Ray 3.6.1, 6/22/05
Click here to download some POV-Ray code for this image. Here is some Mathematica code:(* runtime: 0.02 second *) R = Sqrt[3]; Tiles = {Map[1.0 I{{#, R^2 - # Conjugate[#]}, {1, -Conjugate[#]}}/R &, {R + I, -R + I, -2I}]}; Tiles = Append[Tiles, Flatten[Table[Map[Tiles[[1, i]].Conjugate[Tiles[[1, #]]].Tiles[[1, i]] &, DeleteCases[{1, 2, 3}, i]], {i, 1, 3}], 1]]; Do[Tiles = Append[Tiles, Flatten[Table[Map[Tiles[[g, i]].Conjugate[#].Tiles[[g, i]] &, {Tiles[[g - 1, Ceiling[i/2]]], Tiles[[g, 2Ceiling[i/2] - Mod[i + 1,2]]]}], {i, 1, 3×2^(g - 1)}], 1]], {g, 2, 5}]; Tiles = Flatten[Tiles, 1]; n = Length[Tiles]; ToDisk[{{a_, b_}, {c_, d_}}] := Disk[{Re[a/c], Im[a/c]}, Abs[I/c]]; Show[Graphics[{Hue[0], Disk[{0, 0}, 1], Table[{Hue[Sqrt[i/n]], ToDisk[Tiles[[i]]]}, {i,1, n}]}, AspectRatio -> 1, PlotRange -> {{-1, 1}, {-1, 1}}]] |
Rose-Shaped Parametric Surface - new version: POV-Ray 3.6.1, 6/21/06
old version: Mathematica 4.2, MathGL3d, 3/5/04
This rose is actually a plot of a single continuous math equation. I got this idea while trying to create a visualization of a spiraling spin-lattice relaxation for a physics experiment involving a Nuclear Magnetic Resonance (NMR) spectrometer. Click here to see a larger animation. Click here to see a rotatable 3D version. Click here to download some POV-Ray code for this image. You can also see this on Abdessemed Ali’s web site. See also my Passion Flower. Here is some Mathematica code:(* runtime: 16 seconds *) Rose[x_, theta_] := Module[{phi = (Pi/2)Exp[-theta/(8 Pi)], X = 1 - (1/2)((5/4)(1 - Mod[3.6 theta, 2 Pi]/Pi)^2 - 1/4)^2}, y = 1.95653 x^2 (1.27689 x - 1)^2 Sin[phi]; r = X(x Sin[phi] + y Cos[phi]); {r Sin[theta], r Cos[theta], X(x Cos[phi] - y Sin[phi]), EdgeForm[]}]; ParametricPlot3D[Rose[x, theta], {x, 0, 1}, {theta, -2 Pi, 15 Pi}, PlotPoints -> {25, 576}, LightSources -> {{{0, 0, 1}, RGBColor[1, 0, 0]}}, Compiled -> False] Tessellation Links Rose Curve - another rendering of this rose by Ramiro Perez, see also his Rose Gasket A Rose for Valentine's Day - adaptation for Wolfram Demonstration Project, by Jeff Bryant A Rose for Aexion - another rendering of this rose by parrotdolphin |
“Dinosaur Tessellation” - AutoCAD 2000, AutoLisp, Adobe Photoshop 5.0, 12/9/02
A tessellation is a regular tiling of figures without any gaps or overlapping. If you have access to AutoCAD, you can use this AutoLisp routine to help you design your own tessellations.Tessellation Links Penrose Tiling Java Applet - by Craig Kaplan Maurits Cornelis Esher (M.C. Escher) - famous artist who used tessellations in his artwork Tessellation Java Applet - create your own tessellations |
“Free Spirit Tessellation” - AutoCAD 2000, AutoLisp, Adobe Photoshop 5.0, 5/12/03
I modelled this tessellation after “Spirit” from Disney’s “Spirit - Stallion of Cimarron” movie. I had to overlap the horse’s hind legs because there was not enough room. Still, I think the rest of it fits together remarkably well. |
Maelström Autostereogram - Mathematica 4.2, SISgen 1.58, 10/1/04
This 3D vortex image is hidden in the above picture. To see it, relax your eyes and focus behind the screen. This autostereogram was generated with William Steer’s free autostereogram generating program SISgen. Click here to see an animated version of this picture. I also have a Mathematica-only version of this picture, but it is not as accurate. See also Pascal Massimino’s “Maelstrom” autostereogram.(* Create Depth Map, runtime: 1 minute *) j1 = 615; i1 = 450; depth = Table[0, {i1}, {j1}]; r := Sqrt[x^2 + y^2]; z := 0.03Sin[7(2r - ArcTan[x, y])] - 0.1/r - 0.3; phi = Pi/6; ymax = 1.0/Cos[phi]; Do[flag = False; Do[i0 = ip; ip = Round[(i1 - 1 + (j1 - 1) (y Cos[phi] + z Sin[phi]))/2 + 0.2i1] + 1; z2 = z1; z1 = -y Sin[phi] + z Cos[phi]; If[flag, sign = If[i0 < ip, 1, -1]; j = Round[(j1 - 1)(x + 1)/2] + 1; Do[If[0 < i <= i1, depth[[i, j]] = ((i - i0)z1 + (ip - i)z2)/(ip - i0)], {i, i0 + sign, ip, sign}]]; flag = True, {y, ymax, -ymax, -2.0ymax/i1}], {x, -1, 1, 2.0/j1}]; ListDensityPlot[depth, Mesh -> False, Frame -> False, ImageSize -> {j1, i1}, AspectRatio -> Automatic] (* Create Shift Pattern, runtime: 10 seconds *) i2 = 450; j2 = 90; SeedRandom[0]; pattern = Map[Hue, -50Abs[InverseFourier[Fourier[Table[Random[], {i2}, {j2}]]Table[Exp[-((j/j2 - 0.5)^2 + (i/i2 - 0.5)^2)/0.025^2], {i, 1, i2}, {j, 1, j2}]]], {2}]; Show[Graphics[RasterArray[pattern],ImageSize -> {j2, i2}, AspectRatio -> Automatic]] (* Generate Autostereogram, Note: this code is not very accurate, you are better off using SISgen, runtime: 14 seconds *) f[z_] := 2(14 - 8.7z)/(28 - 8.7z); g[sign_] := Module[{x=0}, Table[x += sign/f[depth[[i, j]]]; pattern[[Mod[i - 1, i2] + 1, Mod[Round[x] - 1, j2] + 1]], {j, Floor[j1/2], If[sign != 1, 1, j1], sign}]]; Show[Graphics[RasterArray[Table[Join[Reverse[g[-1]], g[1]], {i, 1, i1}]], ImageSize -> {j1, i1}, AspectRatio -> Automatic]] Link: Animated Shark Autostereogram - by Fred Hsu |
Expanding Dodecahedron - POV-Ray 3.6.1, 2/1/07
This dodecahedron unfolds and expands by a factor of 2.61803 (the golden ratio plus one). Perhaps it would be possible to construct something similar to this. I think it would make an interesting display for a children’s science museum.Link: Hoberman Sphere - popular icosidodecahedron toy that expands |
Cube - POV-Ray 3.6.1, 1/31/07
This is a cube that expands by a factor of 3. I think it would be difficult to contruct something similar to this.Link: Atomium - 335 foot tall cube building in Brussels built in 1958 |
Stereographic Projection of a Dodecahedron - POV-Ray, 10/10/08
Here is a stereographic projection of a dodecahedron. This is the 3D counterpart to the 4D dodecaplex. Here is some Mathematica code:(* runtime: 0.4 second *) z1 = (Sqrt[5] - 3)/Sqrt[30.0 - 6 Sqrt[5]]; z2 = Sqrt[(1 + 2/Sqrt[5])/3.0]; r1 = Sqrt[2(1 + 1/Sqrt[5])/3.0]; r2 = Sqrt[2(1 - 1/Sqrt[5])/3.0]; vertices = Join[Table[{r2 Cos[theta], r2 Sin[theta], z2}, {theta, 0, 2Pi - 0.4Pi, 0.4Pi}], Table[z1 = -z1; {r1 Cos[theta], r1 Sin[theta], z1}, {theta, 0, 1.8Pi, 0.2Pi}], Table[{r2 Cos[theta], r2 Sin[theta], -z2}, {theta, 0.2Pi, 1.8Pi, 0.4Pi}]]; edges = {{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 1}, {1, 6}, {2, 8}, {3, 10}, {4, 12}, {5, 14}, {6, 7}, {7, 8}, {8, 9}, {9, 10}, {10, 11}, {11, 12}, {12, 13}, {13, 14}, {14, 15}, {15, 6}, {7, 16}, {9, 17}, {11, 18}, {13, 19}, {15, 20}, {16,17}, {17, 18}, {18, 19}, {19, 20}, {20, 16}}; Show[Graphics3D[Map[Line[vertices[[#]]] &, edges]]] norm[x_] := x.x; Normalize[x_] := x/Sqrt[x.x]; Rx[theta_] := {{1, 0, 0}, {0, Cos[theta], -Sin[theta]}, {0,Sin[theta], Cos[theta]}}; ProjectPoint[{x_, y_, z_}] := 2{x, y}/(1 - z); ProjectSegment[{v1_, v2_}] := Module[{p1 = ProjectPoint[v1], p2 = ProjectPoint[v2]}, {nx, ny, nz} = Normalize[Cross[v1, v2]]; If[nz != 0, p0 = -2{nx, ny}/nz; r = 2/Abs[nz]; theta = Sign[nz]Re[ArcCos[(p1 - p0).(p2 - p0)/Sqrt[norm[p1 - p0]norm[p2 - p0]]]], theta = 0]; If[Abs[theta] > 0.001, theta1 = ArcTan[p1[[1]] - p0[[1]], p1[[2]] - p0[[2]]]; theta2 = theta1 + theta; If[theta1 > theta2, t = theta1; theta1 = theta2; theta2 = t]; Circle[p0, r, {theta1, theta2}], Line[{p1, p2}]]]; Do[Show[Graphics[Map[ProjectSegment[Map[Rx[phi].# &, vertices[[#]]]] &, edges], PlotRange -> 6{{-1, 1}, {-1, 1}}, AspectRatio -> Automatic]], {phi, 0, 2Pi, Pi/18}]; |
Moiré Pattern - POV-Ray 3.6.1 version: 4/15/07, Mathematica 4.2 version: 1/29/05
A Moiré pattern is the interference of two similar overlapping patterns. Here is the Moiré pattern on a twisted IKEA wastepaper basket. The mesh on the wastepaper basket was ray-traced from 100,000 tiny cylinders. Here is some Mathematica code to plot Moiré contours around radiating lines:(* runtime: 1.7 seconds *) f[dx_] := Sin[200ArcTan[x - dx, y]]; DensityPlot[f[0.1] - f[-0.1], {x, -1, 1}, {y, -1, 1}, PlotRange -> {0, 1}, PlotPoints -> 275, Mesh -> False, Frame -> False] |
Here is some Mathematica code to plot a Moiré pattern from rapidly varying contours of a function:(* runtime: 0.8 second *) f[z_] := z^3; DensityPlot[Sin[20Pi Abs[f[x + I y]]], {x, -2.5, 2.5}, {y, -2.5, 2.5}, PlotPoints -> 275, Mesh -> False, Frame -> False] Link: Mandelbrot Set Moire Pattern - by Bernard Helmstetter |
(11,3) Torus Knot - Mathematica 4.2, MathGL3d, POV-Ray 3.6.1, 10/31/04
This is one continuous torus knotted on itself. Click here to download an animated screensaver along with C++ source code. Click here to see a rotatable 3D version. The following Mathematica code was adapted from Maxim Rytin’s TubePlot code:(* runtime: 2.6 seconds *) Normalize[x_] := x/Sqrt[x.x]; p[t_] := {(1 + 0.3 Cos[11t/3])Cos[t], (1 + 0.3 Cos[11t/3]) Sin[t], 0.3 Sin[11t/3]}; f[t_, theta_] := Module[{dp = p'[t], ddp = p''[t], tangent, normal1, normal2},tangent = Normalize[dp]; normal1 = Normalize[ddp(dp.dp) - dp(dp.ddp)]; normal2 = Cross[tangent, normal1]; p[t] + 0.1 (normal1 Cos[theta] + normal2 Sin[theta])]; ParametricPlot3D[Append[f[t, theta], {EdgeForm[], SurfaceColor[Hue[t/(2Pi)]]}], {t,0, 6Pi}, {theta, 0, 2Pi}, PlotPoints -> {360, 15}, Compiled -> False] POV-Ray has an internal function for torus knots: // runtime: 8 seconds camera{location 16*y look_at 0} light_source{16*y,1} #declare f=function{internal(24)} isosurface{function{f(x,y,z,6,11,3,0.1,0.5,1,0.1,1,1,0)} max_gradient 2 contained_by{sphere{0,8}} pigment{rgb 1}} Knots Links Bending a Soccer Ball - animations by Michael Trott Celtic knotwork tutorial - by Christian Mercat Knots3D - free Celtic knot program by Steve Abbott, see also KnotsBag by Geraud Bousquet KnotPlot - knot mathematics Gears Trefoil - by Michael Trott Tubes and Knots - Mathematica code by Mark McClure |
Spherical Canvas versus Reflective Sphere - POV-Ray 3.6.1, 10/17/07
This image was inspired by Dick Termes' paintings of 3D worlds on a spherical “canvas” called Termespheres. These images have 6 vanishing points as opposed to linear perspective drawings which only have 3 vanishing points. The left picture shows my version of a spherical canvas for my factory scene. This was accomplished by rendering a spherical panorama of the scene in POV-Ray, and then mapping it to a sphere. Click here to download some sample POV-Ray code. The right picture shows a reflective sphere when viewed from the exact same position. As you can see, it looks quite different. |
3,4,5 Quasi-Homogeneous Domain - C++ version: 8/24/06, Mathematica version: 8/22/06
This was adapted from Anton Lukyanenko’s C++ code. Here is some Mathematica code:(* runtime: 0.2 second *) p = 3; q = 4; r = 5; d = 1.0; s = Sin[Pi/p]; c = Cos[Pi/p]; s2 = Sin[2Pi/p];c2 = Cos[2Pi/p]; p = Inverse[{{-s, c - d, s d}, {s, 3 (c - d), -s d}, {(-3 + 4 c d) s,3 c - (1 + 2 c2) d, -s d}}].{1, 2Cos[2Pi/q], 2Cos[2Pi/r] + 1}; R1 = {{1, 0, 0}, {0, -1, 0}, {0, 0, 1}}; R2 = {{c2, s2, 0}, {s2, -c2, 0}, {0, 0, 1}}; T = {{d, c, p[[1]]}, {0, s, p[[2]]}, {1, 1, p[[3]]}}; R3 = T.{{1, 0, 0}, {0, 1,0}, {0, 0, -1}}.Inverse[T]; Reflect[tile_, R_] := R.# & /@ tile; Children[tile_] := Reflect[tile, #] & /@ {R1, R2, R3}; tiles = {{{0, 0, 1}, {d, 0, 1}, {c, s, 1}}}; Do[tiles = Flatten[Children /@ tiles, 1], {7}]; Show[Graphics[Table[Polygon[Map[{#[[1]], #[[2]]}/#[[3]] &, tiles[[i]]]], {i, 1, Length[tiles]}], AspectRatio -> 1]] |
Hyperboloid - POV-Ray 3.6.1, 6/22/05
Click here to download some POV-Ray code for this image. You can also make hyperboloids quickly in POV-Ray using the quadric command:camera{location <0,10,0> look_at <0,0,0>} light_source{<0,10,0>,1} quadric{<1,1,-1>,<0,0,0>,<0,0,0>,1 pigment{rgb 1}} Link: Gallery of Algebraic Surfaces - by Xiao Gang |
Kluchikov’s Favorite Isosurface - C++ version: 7/8/09; Mathematica and MathGL3d version: 2/28/05
I found some beautiful POV-Ray renditions of this surface on Christoph Hormann’s web site so I decided to see if I could render it using my own ray tracer. The original equation for this implicit surface is attributed to Alex Kluchikov. Isosurfaces are commonly used for scientific visualizations. Here is some Mathematica code:(* runtime: 25 seconds *) << MathGL3d`OpenGLViewer`; x1 = 0.125; y1 = 0.25Sin[2 Pi/3]; Kluchikov[x_, y_, z_, t1_,t2_] := Module[{r = Sqrt[x^2 + z^2] - 1.5, theta = ArcTan[z, x] + Pi/2,t, x2, y2}, t = 8theta/3 + t1; x2 = r Sin[t] + y Cos[t]; y2 = r Cos[t] - y Sin[t]; 0.33(((x2 + 0.25)^2 + y2^2)^(1/64) + ((x2 - x1)^2 + (y2 + y1)^2)^(1/64) + ((x2 - x1)^2 + (y2 - y1)^2)^(1/64)) + 0.01Sin[5theta + t2]]; Scan[MVContourPlot3D[Kluchikov[x, y, z, If[#, 0, Pi/3], If[#, 0, Pi]], {x, -2, 2}, {z, -2, 2}, {y, -0.5, 0.5}, Contours -> {0.945}, PlotPoints -> 100, ContourStyle -> {RGBColor @@ If[#, {0, 0, 1}, {1, 1, 1}]}, MVAlpha -> If[#, 0.5, 1], MVNewScene -> #, MVReturnValue -> None] &, {True, False}] MVPasteGraphics[]; If you do not wish to use the free MathGL3d package, you can use ImplicitPlot3D or ContourPlot3D, but it doesn’t look as nice: (* runtime: 80 seconds *) << Graphics`ImplicitPlot3D`; ImplicitPlot3D[Kluchikov[x, y, z, 0, 0] == 0.945, {x, -2.1, 2.1}, {z, -2.1, 2.1}, {y, -0.55, 0.55}, PlotPoints -> 100] (* runtime: 80 seconds *) << Graphics`ContourPlot3D`; ContourPlot3D[Kluchikov[x, y, z, 0, 0], {x, -2.1, 2.1}, {z, -2.1, 2.1}, {y, -0.55, 0.55}, Contours -> {0.945}, PlotPoints -> 12, ContourStyle -> {EdgeForm[]}] This is how you can make this surface in POV-Ray: // runtime: 7 minutes camera{location 4*y look_at 0 up y right x} light_source{4*y,1} #declare x1=1/8; #declare y1=sin(2*pi/3)/4; #declare Sqr=function(X) {X*X}; #declare theta=function{atan2(x,z)+pi/2}; #declare r=function{sqrt(x*x+z*z)-1.5}; #declare T=function(x,y,z,t1) {8*theta(x,y,z)/3+t1}; #declare x2=function(x,y,z,t1) {r(x,y,z)*sin(T(x,y,z,t1))+y*cos(T(x,y,z,t1))}; #declare y2=function(x,y,z,t1) {r(x,y,z)*cos(T(x,y,z,t1))-y*sin(T(x,y,z,t1))}; #macro Kluchikov(t1,t2,c) isosurface{function{0.33*(pow(Sqr(x2(x,y,z,t1)+1/4)+Sqr(y2(x,y,z,t1)),1/64)+pow(Sqr(x2(x,y,z,t1)-x1)+Sqr(y2(x,y,z,t1)+y1),1/64)+pow(Sqr(x2(x,y,z,t1)-x1)+Sqr(y2(x,y,z,t1)-y1),1/64))+0.01*sin(5*theta(x,y,z)+t2)-0.945} threshold 0 accuracy 0.0002 max_gradient 0.75 contained_by{box{-<2.1,0.55,2.1>,<2.1,0.55,2.1>}} pigment{rgbt c}} #end Kluchikov(0,0,<1,1,1,0>) Kluchikov(pi/3,pi,<0,0,1,0.5>) Link: Polygonising a scalar field - how to make metaballs, by Paul Bourke |
Intersection of 3 Cylinders - POV-Ray 3.6.1, 12/15/08
One thing that has always intrigued me is the intersection of 3 cylinders. This is not a sphere. When viewed from a certain angle, the cross-section is a hexagon. |
Loxodrome - POV-Ray 3.6.1, 10/2/08
A Loxodrome (or Rhumb line) is a spherical spiral. A ship takes this path when it maintains a constant angle with respect to the equator. This image shows a loxodrome intertwined with spirals.Links Loxodromic Fractal World - by Ramiro Perez |
Golden Ratio Logarithmic Spiral Transformation - Mathematica 4.2, 6/21/04
The Golden Ratio f = (1 + sqrt(5))/2 ≈ 1.61803 has an interesting relationship with Fibonacci Numbers. The basic equation for a Golden Spiral is given by r(q) = f2q/p. The interlocking rings pattern in this image was adapted from M. C. Esher’s Snakes. Here is some Mathematica code:(* runtime: 48 seconds *) image = Import["C:/Picture.jpg"][[1, 1]]/255.0; imax = Length[image]; jmax = Length[image[[1]]]; n = 275; phi = 0.5 (1 + Sqrt[5]); Show[Graphics[RasterArray[Table[Module[{x = 2j/n - 1, y = 2i/n - 1, r, theta}, r = x^2 + y^2; theta = ArcTan[y, x]; RGBColor @@ If[r != 0, image[[Floor[imax Mod[2theta/Pi, 1]] + 1, Floor[jmax Mod[theta/Pi + 0.25Log[r]/Log[phi], 1]] + 1]], {0, 0, 0}]], {i, 1, n}, {j, 1, n}]], ImageSize -> n, PlotRange -> {{0, n}, {1, n}}, AspectRatio -> 1]] Links Droste Effect Gallery - recursive pictures by Josh Sommers |
Complex Map Polar Transformation: f(z) = e2 p z - Mathematica 4.2, 6/14/04
These images were generated by mapping a tessellation to the complex plane, similar to M. C. Esher’s Development II. Here is some Mathematica code:(* runtime: 80 seconds *) image = Import["Picture.jpg"][[1, 1]]; n = Length[image]; m = Length[image[[1]]]; Show[Graphics[RasterArray[Table[RGBColor @@ Module[{z = Log[2j/275 - 1 + I (2i/275 - 1)]/(2Pi) + 1.0}, image[[Floor[n Mod[6 m Re[z]/n, 1]] + 1, Floor[m Mod[6 Im[z], 1]] + 1]]/255.0], {i, 1, 275}, {j, 1, 275}]], ImageSize -> 275, PlotRange -> {{0, 275}, {1, 275}}, AspectRatio -> 1]] |
Fisheye Transformation - Mathematica 4.2, 6/15/04
Here is some Mathematica code:(* runtime: 26 seconds *) image = Import["C:/Picture.jpg"][[1, 1]]; n = Length[image]; m = Length[image[[1]]]; Show[Graphics[RasterArray[Table[RGBColor @@ Module[{x = 2j/275 - 1, y = 2i/275 - 1, r, h}, r = 1.0 - x^2 - y^2; h = 0.5(1 - 0.5If[r > 0, Sqrt[r], 0]); image[[Floor[n Mod[5 m h x/n, 1]] + 1, Floor[m Mod[5 h y, 1]] + 1]]/255.0], {i, 1, 275}, {j, 1, 275}]], ImageSize -> 275, PlotRange -> {{0, 275}, {1, 275}}, AspectRatio -> 1]] |
RSA Encryption (Rivest, Shamir and Adleman) - Mathematica 4.2, 11/15/06
|
Here is some Mathematica code to encrypt messages using prime numbers. Anyone with the public key (and n) can encode messages, but only the person with the secret key can decode them: (* runtime: 0.05 second *) message = "This is a secret message containing 112 characters. This message will be divided into 4 blocks of 28 characters."; << NumberTheory`NumberTheoryFunctions`; SeedRandom[0]; PublicKey = NextPrime[Random[]256^28]; p = NextPrime[Random[]256^14]; q = NextPrime[256.0^28/p]; n = p q; SecretKey = PowerMod[PublicKey, -1, (p - 1)(q - 1)]; ToNumbers[str_] := Map[FromDigits[#, 256] &, Partition[ToCharacterCode[str], 28]]; ToText[nlist_] := StringJoin @@ Map[StringJoin @@ Map[FromCharacterCode, IntegerDigits[#, 256, 28]] &, nlist]; encryption = ToText[Map[PowerMod[#, PublicKey, n] &, ToNumbers[message]]] ToText[Map[PowerMod[#, SecretKey, n] &, ToNumbers[encryption]]] If you do not know p and q, you can try to break the code using this method (but it is very slow): (* runtime: 40 minutes *) SecretKey = PowerMod[PublicKey, -1, EulerPhi[n]]; Here’s a basic idea how these functions work: InverseMod[a0_, n0_] := Module[{n = n0, a = a0, x = 0, x1 = 0,x2 = 1, q1 = 0, q2 = 0, i = 1}, While[a != 0, If[i > 2, x = Mod[x1 - x2 q1 + n0^2, n0]; x1 = x2; x2 = x]; q1 = q2; q2 = Floor[n/a]; {n, a} = {a, Mod[n, a]}; i++]; Mod[x1 - x2 q1 + n0^2, n0]]; PowerMod[a_, b_, n_] := If[b == -1, InverseMod[a, n], Module[{c = 1}, digits =IntegerDigits[b, 2]; Scan[If[#[[1]] == 1, c = Mod[c #[[2]], n]] &, Transpose[{digits, Reverse[NestList[Mod[#^2, n] &,a, Length[digits] - 1]]}]]; c]]; GCD[a_, b_] := If[b == 0, a, GCD[b, Mod[a, b]]]; Link: RSA Encryption - Mathematica notebook by Kit Dodson |
Spirographs - MacDraw (vector art), 1992?
I made these a very long time ago on my old Macintosh. I don’t remember how to make them anymore. |
Mathematica Typesetting Shortcuts
Here is a Mathematica notebook that summarizes some convenient Mathematica typesetting shortcuts. You can type equations quite quickly in Mathematica once you know these shortcuts. I use these shortcuts to type my class notes in Mathematica.
Mathematica Links
Mathematica - excellent technical computing software, easy to make beautiful plots and play equations as sounds
MathGL3d - free Mathematica package for rendering with OpenGL and writing POV-Ray scripts
LiveGraphics3D - software for displaying rotatable 3D Mathematica graphics on the internet
JavaView - another program similar to LiveGraphics3D
Mathematica Information Center - many sample notebooks & packages
Mathematicians
The Thirty Greatest Mathematicians - interesting biographies by James Dow Allen
Leonhard Euler - had a photographic memory, did his greatest work after he went blind, saying "Now I will have less distraction"
Carl Gauss - perhaps the greatest mathematican who ever lived, corrected his family finances at the age of 3
Srinivasa Ramanujan - self-taught mathematician who grew up in poverty and baffled leading mathematicians, developed amazing formulas for pi
Évariste Galois - proved there is no quintic formula, died in a duel at age 20 over a woman
Andrew Wiles - solver of Fermat's Last Theorem
John Nash - the movie "A Beautiful Mind" is based on his life
Other Math Links
MathWorld - mathematics dictionary
Mathematica Art - I especially like the animated GIFs
Sphere Eversion - beautiful animation turning a sphere inside-out by Bill Thurston
Penrose Tiling - amazing aperiodic tilings discovered by Roger Penrose, here is a Mathematica notebook by E. Arthur Robinson
Hyperseeing - electronic publication by The International Society of the Arts, Mathematics, and Architecture
Chatin’s Constant - the infamous “incalculable” constant, the probability that a random algorithm halts
Who can name the Biggest Number? - Chained Arrow Notation, Busy Beavers
Large Numbers
Fractional Calculus - fractional derivatives
Discrete Cosine Transform - how JPEGs are made
Hyperspheres - surface areas & volumes of n-dimensional spheres
Strang’s Strange Figures - unexpected patterns in trig functions
Wikipedia article on p
Gödel's Incompleteness Theorem - famous paper that supposedly defeats all hope of formally proving all truth. I can’t say I understand it, but it’s interesting (and controversial).
Chinese Rings - a simple puzzle that can be solved in no less than 18446744073709551616 moves
Number Spiral - interesting pattern of prime numbers
echochrome - M.C. Escher video game
Probability theory paradoxes - Monty Hall problem, Simpson's paradox