This notebook contains additional material to the Mathematica GuideBooks  (Springer-Verlag, New York, 2004) http://www.MathematicaGuideBooks.org . It uses the stylesheet of the Mathematica GuideBooks, which is embedded.

Numerics Volume, Chapter 2

Make 3D visualizations of the argument of the cyclotomic polynomials Arg((Subscript[C, k])(z)) over the complex z-plane.

Show[GraphicsArray[ 
Block[{k = 5, $DisplayFunction = Identity}, 
  {Plot3D[Evaluate[Arg @ Cyclotomic[8, x + I y]], 
                   {x, -2, 2},{y, -2, 2}, PlotPoints -> 60],
   ParametricPlot3D[{r Cos[φ], r Sin[φ], Arg[Cyclotomic[5, r Exp[I φ]]]}, 
                 {r, 0, 2.5}, {φ, 0, 2Pi}, PlotPoints -> 60, 
                 BoxRatios -> {1, 1, 0.6}]}]]]

The next function CyclotomicBranchCutLines calculates the curves along which the above discontinuities occur.

CyclotomicBranchCutLines[o_] :=
Module[{L = 2.5, επ = Pi 10^-8, εe = E 10^-8, cls, 
        lines, branchCutLines}, 
 (* contour plot of the curves Im[Cyclotomic[o, z]] == 0 *)
 cls = ContourPlot[Evaluate[Im @ Cyclotomic[o, x + I y]], 
                   {x, -L + επ, L}, {y, -L + εe, L}, PlotPoints -> 60, 
                   Contours -> {0}, ContourShading -> False,
                   DisplayFunction -> Identity];
 (* extract curves *)
 lines = Flatten[Partition[#[[1]], 2, 1]& /@ 
                  Cases[Graphics[cls], _Line, Infinity], 1];    
 (* select curve segments where Cyclotomic[o, x + I y] < 0 *)
 branchCutLines = Line /@ Select[lines, (#.#&[Plus @@ #/2] > 1 &&
                          Re[Cyclotomic[o, (Plus @@ #/2).{1, I}]] < 0)&]]

Here are the curves of discontinuity of Arg((Subscript[C, k])(z)) for k=1,…,36 shown. All curves originate from the unit circle, which contains the zeros of the cyclotomic polynomials.

Module[{oMax = 36},
Show[Graphics[{{GrayLevel[0.5], Thickness[0.02], Circle[{0, 0}, 1]}, 
              {Thickness[0.004],
               Table[{Hue[0.8o/oMax], CyclotomicBranchCutLines[o]}, 
                     {o, 1, oMax}]}}], PlotRange -> All, 
                     AspectRatio -> Automatic, Frame -> True]]

To avoid the steep vertical walls in the 3D graphics above, we will now partition the complex z-plane into wedges bound by the lines of discontinuity. In general, these lines will be described by complicated polynomial roots. For a visualization, it is enough to obtain the curves numerically. We do this by solving the corresponding differential equation radially outwards. The function cyclotomicArgPlot3D does this, then partitions the wedges into quadrilaterals, and finally constructs the corresponding 3D polygons.

cyclotomicArgPlot3D[o_, R_, {ppr_, ppφ_}] :=
Module[{ε = 10^-8, im, zeroArgs, ode, ndsols}, 
 (* imaginary part of the cyclotomic polynomial *)
 im = ComplexExpand[Im[Cyclotomic[o, x + I y]]];
 (* position of zeros on the unit circle *)
 zeroArgs = Sort[N[Arg[z /. Solve[Cyclotomic[o, z] == 0, z]], 30]];
 (* solve ODE for Im[Cyclotomic[o, z]] == 0 radially outwards *)
 ode = D[im /. {x -> r Cos[φ[r]], y -> r Sin[φ[r]]}, r];
 ndsols = NDSolve[{ode == 0, φ[1] == #}, φ, {r, 1, R},
                  PrecisionGoal -> 12, WorkingPrecision -> 20]& /@ zeroArgs;
 (* make wedges without discontinuities *)
 rs = Table[r, {r, 1, R, (R - 1)/ppr}];
 φTab = Flatten[φ[#] /. ndsols]& /@ rs;
 φRanges = Transpose[({#1 + ε, #2 - ε}& @@@ 
                     Partition[Append[#, First[#] + 2Pi], 2, 1])& /@ φTab];
 (* points in the wedges *)
 zs = Table[Table[rs[[k]] Exp[I φ], 
            {φ, φRanges[[j, k, 1]], φRanges[[j, k, 2]],
             (φRanges[[j, k, 2]] - φRanges[[j, k, 1]])/ppφ}],
           {j, Length[φRanges]}, {k, Length[rs]}];      
 (* points in the wedges *)
 points = Map[{Re[#], Im[#], Arg[Cyclotomic[o, #]]}&, #, {2}]& /@ zs;
 (* polygons in for the 3D plot *)
 patches = Table[Polygon[{#[[i, j]], #[[i, j + 1]],  
                          #[[i + 1, j + 1]], #[[i + 1, j]]}],
                 {i, Length[#] - 1}, {j, Length[#[[1]]] - 1}]& /@ points;
 (* polygons inside the unit circle;
    use azimuthal wedge subdivision for smooth transition *)
 pprI = Ceiling[(R - 1)/R ppr];
 zsI = Table[Table[k/pprI Exp[I φ], 
             {φ, φRanges[[j, 1, 1]], φRanges[[j, 1, 2]],
              (φRanges[[j, 1, 2]] - φRanges[[j, 1, 1]])/ppφ}],
             {j, Length[φRanges]}, {k, 0, pprI}];                      
 pointsI = Map[{Re[#], Im[#], Arg[Cyclotomic[o, #]]}&, #, {2}]& /@ zsI;
 patchesI = Table[Polygon[{#[[i, j]], #[[i, j + 1]],  
                           #[[i + 1, j + 1]], #[[i + 1, j]]}],
                 {i, Length[#] - 1}, {j, Length[#[[1]]] - 1}]& /@ pointsI;                
 (* color polygon according to argument of cyclotomic polynomial *)
 coloredPolygons = Join[patches, patchesI] /.
        p_Polygon :> {SurfaceColor[#, #, 2.2]&[
          Hue[0.78 ((Plus @@ (Last /@ N[p[[1]]])/4) + Pi)/(2 Pi)]], p};                
 (* show graphic *)
 Show[Graphics3D[{EdgeForm[], coloredPolygons}, BoxRatios -> {1, 1, 0.4},
       Axes -> False, Boxed -> False]]]

Here are the 3D graphics of  Arg((Subscript[C, 2])(z)),  Arg((Subscript[C, 3])(z)), and  Arg((Subscript[C, 4])(z)).

Show[GraphicsArray[cyclotomicArgPlot3D[#, 2.5, {36, 36}]& /@ {2, 3, 5}]];

And here is the corresponding graphic for  (Subscript[C, 11])(z).

cArg = cyclotomicArgPlot3D[11, 2.5, {36, 36}]

The last graphic tempts one to do an animation showing a rotating version of the last graphic.

frames = 60;
Do[ℛ = {{Cos[φ], Sin[φ], 0}, {-Sin[φ], Cos[φ], 0}, {0, 0, 1}} // N;
   Show[cArg /. Polygon[l_] :> Polygon[ℛ.#& /@ l]],
   {φ, 0, 2Pi (1 - 1/frames), 2Pi/frames}]