Rose-Shaped Parametric Surface

This rose is actually a plot of a single continuous math equation. 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.new version: POV-Ray 3.6.1, 6/21/06 old version: Mathematica 4.2, MathGL3d, 3/5/04 (* 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]

Breather Pseudosphere

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. Click here to download some POV-Ray code for this image. You can also see this image described as an “Imploding Flower” on Chewxy’s Math Art

new version: POV-Ray 3.6.1, 6/21/06
old version: Mathematica 4.2, MathGL3d, POV-Ray 3.6.1, 9/30/04

(* 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 website.

Magnetic Field of a Solenoid

This magnetic field was approximated by a superposition of 2D point sources using the Biot-Savart Law. You can also see the old version of this picture on Jeff Bryant’s Mathematica visualization site. Click here to download the POV-Ray code for this image. See also my magnetic field representations for a motor, Tesla coil, and horseshoe magnets.

new version: POV-Ray 3.6.1, 5/17/06; old version: calculated in Mathematica 4.2, rendered in TrueSpace 4.3, 1/19/03

(* runtime: 12 seconds *)
plist = Table[{(4 i - 26)/6, -(-1)^i}, {i, 1, 12}]; r[{xi_, yi_}] := Sqrt[(x - xi)^2 + (y - yi)^2];
DensityPlot[2Sqrt[((Plus @@ Map[#[[2]](x - #[[1]])/r[#]^2 &, plist])^2 + (Plus @@ Map[-#[[2]](y - #[[2]])/r[#]^2 &, plist])^2)] + Cos[18.8Plus @@ Map[#[[2]]/r[#] &, plist]] + 1, {x, -6, 6}, {y, -3, 3}, Mesh -> False, Frame -> False, PlotRange -> {0, 10}, PlotPoints -> {275, 138}, AspectRatio -> 1/2]

Torsion Beam

Here is an exaggerated example of a beam being twisted. The following code is based on Stephen Timoshenko’s analytical solution. The color represents the equivalent (Von Mises) stress where red is high stress and blue is low stress.
(* runtime: 12 seconds *)
a = b = 2.0; L = 10; T = G = 1; J = 16/3a^3b(1 - 196a/(b Pi^5)Sum[n^-5Tanh[n Pi b/(2a)], {n, 1, 200, 2}]); k = T/(G J);
phi = 32G k a/Pi^3Sum[1/n^3(-1)^((n - 1)/2)(1 - Cosh[n Pi y/(2a)]/Cosh[n Pi b/(2a)])Cos[n Pi x/(2a)], {n, 1, 10, 2}];
tauyz = -D[phi, x]; tauxz = D[phi, y]; tauxy = sx = sy = sz = 0;
f[x_, y_, z_] := Module[{}, {s1, s2, s3} = Eigenvalues[{{sx, tauxy, tauxz}, {tauxy, sy, tauyz}, {tauxz, tauyz, sz}}]; sv = Sqrt[((s1 - s2)^2 + (s2 - s3)^2 + (s3 - s1)^2)/2]; {x - k z y, y + k z x, z, {EdgeForm[], SurfaceColor[Hue[2(1 - sv/0.029)/3]]}}];
<< Graphics`Master`;
DisplayTogether[Map[{ParametricPlot3D[f[#a/2, y, z], {y, -b/2, b/2}, {z, 0,L}, Compiled -> False], ParametricPlot3D[f[x, #b/2, z], {x, -a/2, a/2}, {z, 0, L}, Compiled -> False]} &, {-1, 1}], ParametricPlot3D[f[x, y, L], {x, -a/2, a/2}, {y, -b/2, b/2}, Compiled -> False]];

Links

• Computer Modeling – class notes by Nasser Abbasi
• Torsional Analysis – part of the Structural Mechanics Mathematica package

Flapping Wing

This flapping wing was calculated using the unsteady vortex panel methodAlan Lai’s Fortran code. It assumes inviscid incompressible potential flow (irrotational). I also have a working Mathematica version of this code, but it is a little lengthy to show here.

Flapping Wing – Fortran 90, rendered in POV-Ray 3.6.1, 4/28/06

Links

• Unsteady Panel Code Simulations – by Kevin Jones
• Insect Flight – Jane Wang made one of the first simulations to predict that an insect can produce sufficient lift to remain aloft. Here is another article about it. See also these Vortex Method Simulations by Jeff Eldredge.
• Robotic Fly – Uses piezoelectric actuators, by Ron Fearing. See also his Microfly with piezoelectric actuators.
• Harvard Microrobotics Lab – see this video
• Flapping MAV – interesting design by Kevin Jones
• Biomimetics – Biomimetics is the study of biological mechanisms in order to engineer machines that can mimic them.
• RoboCup – International robotic soccer competitions. Their goal is to build robots that can defeat champion human soccer players by the year 2050. It looks like they still have a way to go. See also RoboGames.
• Bionic Dolphin – this submarine is too buoyant to go underwater, but when it is going fast enough, its “flippers” work like upside-down airplane “wings” to force it under water.
• Airic’s Arm – bionic arm operated by “Fluidic Muscles”
• more biomimetics links: Air-Ray (very cool flying manta ray), Aqua-Ray (underwater manta ray), Snake Robot (see video and sidewinding snake), robotic dragonfly toy, NASA’s robotic serpent, BigDog, Spinybot II wall climber, RoboPike, robotic caterpillar, RoboSnail, robotic mule, RoboStrider, RoboRoach hexapod, robotic dolphin, RoboLobster adapted from

Water Caustics

This water-like surface was generated in Mathematica using frequency filtered random noise, and then it was raytraced in POV-Ray and water caustics were added using Henrik Jensen’sphoton mapping technique. The smooth_triangle command was used for phong normal interpolation of the water’s surface.

Link: Water Caustics Generator – C++ program by Kjell Andersson, uses Heron’s Formula to calculate the caustics

Kleinian Quasifuchsian Limit Set

Here is a Sunset Moth “blown about” inside a Quasifuchsian limit set. Originally, Felix Klein described these fractals as “utterly unimaginable”, but today we can visualize these fractals with computers.

(* runtime: 12 seconds *)
ta = tb = 1.91 + 0.05I; tab = (ta tb + Sqrt[ta^2tb^2 - 4(ta^2 + tb^2)])/2; z0 = (tab - 2)tb/(tb tab - 2ta + 2I tab);
b = {{tb - 2I, tb}, {tb, tb + 2I}}/2; B = Inverse[b]; a = {{tab, (tab - 2)/z0}, {(tab + 2)z0, tab}}.B; A = Inverse[a];
Reflect[{{a_, b_}, {c_, d_}}, z_] := (b + a z)/(d + c z);
ReflectList[C_, zlist_] := Reflect[C, #] & /@zlist; Children[zlist_] := ReflectList[#, zlist] & /@ {a, b, A, B};
zlist = {0.23 + 0.03 I, 0.18 + 0.05 I, 0.62 + 0.45 I, 0.86 + 0.73 I, 0.91 + 0.89 I, 0.88 + 0.97 I, 0.75 + 0.98 I, 0.48 + 0.88 I, 0.25 + 0.85 I, 0.04 + 0.79 I, -0.02 + 0.67 I, -0.1 + 0.78 I, -0.14 + 0.77 I, -0.24 + 0.84 I, -0.24 + 0.77 I, -0.41 + 0.88 I, -0.39 + 0.77 I, -0.5 + 0.82 I, -0.48 + 0.74 I, -0.82 + I, -0.86 + 0.96 I, -0.68 + 0.79 I, -0.7 + 0.74 I, -0.89 + 0.81 I, -0.74 + 0.64 I, -0.77 + 0.6 I, -0.91 + 0.65 I, -0.8 + 0.51 I, -0.87 + 0.44 I, -0.71 + 0.32 I, -0.44 + 0.19 I, -0.07 + 0.08 I, -0.38 + 0.03 I};
zlists1 = zlists2 = {0.5 + 0.125Join[Reverse[Conjugate[zlist]], zlist]}; test[zlist1_, zlist2_] := Abs[zlist2[[1]] - zlist1[[1]]] < 0.05; While[zlists2 =!= {},zlists2 = Complement[Flatten[Children /@ zlists2, 1], zlists1, SameTest -> test]; zlists1 = Union[zlists2, zlists1, SameTest -> test]];
Show[Graphics[Line[{Re[#], Im[#]} & /@ #] & /@ zlists1], AspectRatio -> Automatic];

Quasifuchsian Limit Set

Here is some Mathematica code for a simple Quasifuchsian Limit Set:
(* runtime: 15 seconds *)
ta = 1.87 + 0.1I; tb = 1.87 - 0.1I; tab = (ta tb + Sqrt[ta^2tb^2 - 4(ta^2 + tb^2)])/2; z0 = (tab - 2)tb/(tb tab - 2ta + 2I tab);
b = {{tb - 2I, tb}, {tb, tb + 2I}}/2; B = Inverse[b]; a = {{tab, (tab - 2)/z0}, {(tab + 2)z0, tab}}.B; A = Inverse[a];
Affine[{z1_, z2_}] := 0.01 Round[(z1/z2)/0.01]; Children[{z_, n_}] := {Affine[{a, b, A, B}[[#]].{z, 1}], #} & /@ Delete[Range[4], {3,4, 1, 2}[[n]]];
ListPlot[{Re[#[[1]]], Im[#[[1]]]} & /@ Nest[Union[Flatten[Children /@ #, 1]] &, Table[{Affine[{a, b, A, B}[[i]].{0, 1}],i}, {i, 1, 4}], 12], AspectRatio -> Automatic, PlotRange -> All];

Link: 3D Maskit Slices – by Kentaro Ito

Inverse 4D Quaternion Julia Set

Here is the 4D quaternion Julia set using the inverse Julia set technique. The 4th dimension has been color-coded. This method is much faster, but some regions are faint because they attract much slower. See also my POV-Ray code and rotatable 3D version. Here is some Mathematica code:
(* runtime: 5 seconds *)
Sqrt2[q_] := Module[{r = Sqrt[Plus @@ Map[#^2 &, q]], a, b}, a = Sqrt[(q[[1]] + r)/2]; b = (r - q[[1]]) a/(q[[2]]^2 + q[[3]]^2 + q[[4]]^2); {a, b q[[2]], b q[[3]], b q[[4]]}];
QInverse[qlist_] := Flatten[Map[Module[{q = Sqrt2[# - qc]}, {q, -q}] &, qlist], 1];
qc = {-0.2, 0.8, 0, 0}; qlist = {{1.0, 1.0, 1.0, 1.0}};
Do[qlist = QInverse[qlist], {12}];
Show[Graphics3D[{PointSize[0.005], {Hue[#[[4]]], Point[Delete[#, 4]]} & /@ qlist}, Boxed -> False, Background -> RGBColor[0, 0, 0]]]

Links

• QJulia – inverse quaternion Julia set program by Chris Laurel
• Quaternion Julia Crystal – laser-etched cube by Bathsheba Grossman

Magnet Fractals

These fractals were originally designed for predicting magnetic phase-transitions.

Here is some Mathematica code:
Mandelbrot[zc_] := Length[FixedPointList[f[#, zc] &, 0, 100, SameTest -> (Abs[#] > 2 &)]];
Magnet[] := DensityPlot[Log[Mandelbrot[xc + I yc]], {xc, -1, 3}, {yc, -2, 2}, PlotPoints -> 275, Mesh -> False, Frame -> False, ColorFunction -> (If[# != 1, Hue[#], RGBColor[0, 0, 0]] &)];

(* Magnet 1: runtime: 5 minutes *)
f[z_, zc_] := (z^2 + zc - 1.0)^2 / (2 z + zc - 2)^2;
Magnet[];

(* Magnet 2: runtime: 15 minutes *)
f[z_, zc_] := (z^3 + 3 (zc - 1) z + (zc - 1) (zc - 2))^2 / (3 z^2 + 3 (zc - 2) z + (zc - 1) (zc - 2) + 1.0)^2;
Magnet[];

POV-Ray has a built-in function for these fractals:
//Magnet 1: runtime: 0.5 second
camera{orthographic location <1.25,0,-2> look_at <1.25,0,0> angle 90}
plane{z,0 pigment{magnet 1 mandel 50 interior 1,1 color_map{[0 rgb 0][1/6 rgb <0,0,1>][1/3 rgb 1]}} finish{ambient 1}}

//Magnet 2: runtime: 0 seconds
camera{orthographic location <1,0,-2> look_at <1,0,0> angle 90}
plane{z,0 pigment{magnet 2 mandel 50 color_map{[0 rgb 0][1/6 rgb <1,0,0>][1/3 rgb 1][1 rgb 1][1 rgb 0]}} finish{ambient 1}}