12
$\begingroup$

In reading Michael Trott's Visualization of Riemann Surfaces of Algebraic Functions, he has:

ParametricPlot3D[{r Cos[φ], r Sin[φ], Sqrt[r] Sin[φ/2], SurfaceColor[Hue[φ/(4 π)]]},
                 {r, 0, 1}, {φ, 0, 4 π}, PlotPoints -> {20, 60},
                 Boxed -> False, Axes -> False]

How would you do this coloring now in Mathematica 9?

$\endgroup$
16
$\begingroup$

Natively in V9, you can do the following:

ParametricPlot3D[{r Cos[phi], r Sin[phi], Sqrt[r] Sin[phi/2]}, {r, 0, 1}, 
 {phi, 0, 4 Pi}, PlotPoints -> {20, 60}, Boxed -> False, Axes -> False,
  ColorFunction -> (Hue[#5/(4 Pi)] &), ColorFunctionScaling -> False]

enter image description here

Alternatively, you can always use the exact code using the V5 emulator:

<<Version5`Graphics`
ParametricPlot3D[{r Cos[phi], r Sin[phi], Sqrt[r] Sin[phi/2], 
  SurfaceColor[Hue[phi/(4 Pi)]]}, {r, 0, 1}, {phi, 0, 4 Pi}, 
  PlotPoints -> {20, 60}, Boxed -> False, Axes -> False]

enter image description here

Of course, the graphics aren't quite as nice. You can go back to the newer style graphics as follows:

<<Version6`Graphics`
$\endgroup$
14
$\begingroup$

As of Version 6, SurfaceColor has been superseded by Specularity and Glow.

One could specify the variables explicitly like here :

ParametricPlot3D[{ r Cos[φ], r Sin[φ], Sqrt[r] Sin[φ/2]}, {r, 0, 1}, {φ, 0, 4 π},
   ColorFunction -> Function[{x, y, z, r, φ, θ},
                      {Specularity[#], Glow[#]}& @ Hue[Rescale[φ, {0, 1}]]],
   PlotPoints -> {20, 60}, Boxed -> False, Axes -> False]

enter image description here

or adding a more thrilling variation of ColorFunction (singularity when r -> 0) :

ParametricPlot3D[{ r Cos[φ], r Sin[φ], Sqrt[r] Sin[φ/2]}, {r, 0, 1}, {φ, 0, 4 π},
    ColorFunction -> Function[{x, y, z, r, φ, θ},
                       {Specularity[#], Glow[#]}& @ Hue[ Rescale[ φ/r, {0, 1}]]],
    PlotPoints -> {20, 60}, Boxed -> False, Axes -> False]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ I think you're missing an argument. It should be Function[{x, y, z, r, φ}, ...]. $\endgroup$ – Rahul Dec 28 '12 at 22:58
  • $\begingroup$ Yes, I improved the arguments. Thanks. $\endgroup$ – Artes Dec 28 '12 at 23:16
4
$\begingroup$

...and now, for something that takes a bit of the old, and a bit of the new:

ColoredMakePolygons[vl_List] := Module[{msh = Map[Most, vl, {2}], cols, dims},
        cols = Map[First[Cases[Last[#], _?ColorQ, {0, Infinity}]] &, vl, {2}];
        cols = Map[If[Head[#] === GrayLevel, #, ColorConvert[#, RGBColor]] &,
                   cols, {2}];
        dims = Most[Dimensions[msh]];
        GraphicsComplex[Apply[Join, msh], Polygon[Flatten[Apply[
                        Join[Reverse[#1], #2] &, 
                        Partition[Partition[Range[Times @@ dims], Last[dims]],
                                  {2, 2}, {1, 1}], {2}], 1]],
                        VertexColors -> Apply[Join, cols]]] /;
ArrayDepth[vl] == 3 && Last[Dimensions[vl]] == 4

With[{m = 21, n = 61}, 
     Graphics3D[ColoredMakePolygons[
                N @ Table[{r Cos[φ], r Sin[φ], Sqrt[r] Sin[φ/2], Hue[φ/(4 π)]},
                          {r, 0, 1, 1/(m - 1)}, {φ, 0, 4 π, 4 π/(n - 1)}]], 
                Boxed -> False, Lighting -> "Neutral"]]

phase-colored Riemann surface, old-style

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.