Archive for the 'Math' Category



01
Oct
08

Double Spiral

One way to create a Double Spiralis by applying a light projection from the top of a Riemann sphere (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

Advertisements
12
Aug
08

Clifford Torus

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.

Click here to download some POV-Ray code. The right picture shows a complex cubic polynomial.

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

15
Apr
08

Moiré Pattern

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:

06
Jun
07

Richmond’s Minimal Surface

I learned about this minimal surface from Brian Johnston’s website. Here is some Mathematica code:

(* runtime: 2 seconds *)
Richmond[n_, z_] := {-1/(2z) - z^(2n + 1)/(4n + 2), -I/(2z) + I z^(2n + 1)/(4n + 2), z^n/n};
ParametricPlot3D[Re[Richmond[5, r Exp[I theta]]], {r, 0.53, 1.187}, {theta, 0, 2Pi}, PlotPoints -> {25, 180}, Compiled -> False]

24
Apr
07

Homotopy

This began as an attempt to animate a similar-looking structure to Bathsheba Grossman’s beautiful Quin Pendant Lamp. Depending on your point of view, this knotted structure 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

15
Feb
07

Inside the Hyperbolic Dodecahedron

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 ideal dodecahedrons. Notice that when the space becomes elliptic, a “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

15
Feb
07

Hyperbolic Dodecahedron

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




Welcome !

You will find here some of my favorite hobbies and interests, especially science and art.

I hope you enjoy it!

Subscribe to the RSS feed to stay informed when I publish something new here.

I would love to hear from you! Please feel free to send me an email : bugman123-at-gmail-dot-com

Archives

Blog Stats

  • 555,424 hits
Advertisements