Understanding Pie Chart Annulus generation and alternate style using Disk[]

Question

Background

I have been working with a set of data for some time now and I recently decided to change the format. The data is a tree-styled listing of hierarchical names and positions.

(* Names have been removed. *)

My goal is to take the tree and convert it into a different form, something like one of these:

(* Once again, name has been removed from Tooltip *)

I am currently doing this with the Disk[] primitive, but this requires me to build it up from the ground (outside) instead of the top (inside) so that they stack properly and the inner layers are visible.

The Question

The PieChart[] method built into Mathematica provides an option for removing a portion of the chart (the annulus of the circle) using SectorOrigin->{{pos,sense}, r_inner}. Unfortunately the Disk primitive does not have the same ability (as far as I can tell...) so I looked at the full code for the creation of a simple donut chart:

PieChart[{1,1}, SectorOrigin->{Automatic,1}]//FullForm

The full form code explains that the PieChart creates the sectors as point listed polygons instead of as something a little more simple.

Is there a better way to go about removing the center portion of a Disk[] without generating a list of points and joining them as a polygon? I ask this question because it seems that this should be an option for Disk[] and I'm curious to know if I have missed something. The end result should allow me to generate the sectors of the Sunburst Chart above without having to pay attention to the order in which it was generated (no centers means the chart wouldn't require a certain stacking order).

Also

As a side note : I considered using Circle with the Thickness option:

 Graphics[{Thickness[0.05],Circle[{0,0},1,{0,Pi}]}]

but the generated output is not partitioned properly and gives more of a U shape than a pie sector.

A module I used when coming up with the idea

Unfortunately the data does not have even divisions, so the model represented here isn't good for the data (nor does it use the data to create the chart), but it may help you understand how I stumbled onto the question. I can't seem to believe that Mathematica doesn't have that option built in to one of the primitives

Manipulate[ Module[ {makeDisk, tree, partitions, color, range},

  range = {lowerlim, upperlim, upperlim - lowerlim};

  (* Plotting Colors *)
  color = {RGBColor[32/255, 0/255, 64/255], RGBColor[64/255, 0/255, 127/255], RGBColor[128/255, 0/255, 255/255], RGBColor[96/255, 0, 191/255], RGBColor[115/255, 0/255, 229/255]};

  (* Applying colors 1 - top level, 2,3 - even levels, 4,5 - odd levels *)
  colorApplied[level_, division_] := If[level != 1, If[EvenQ[level], If[EvenQ[division], color[[2]], color[[3]]], If[EvenQ[division], color[[4]], color[[5]]]], color[[1]]];

  (* Function to make disks *)
  makeDisk[level_, divisions_] := Module[{fan}, 
    partitions = divisions^(level - 1); 
    fan = Table[{EdgeForm[Thick], colorApplied[level, i], Disk[{0, 0},level,lowerlim + Partition[Table[(n*range[[3]])/partitions, {n, 0, partitions}], 2, 1][[i]]]},{i, 1, partitions}];
    Return[fan]
    ];

  (* Tree Construction *)
  tree = Append[Drop[Table[makeDisk[(levels - level + 1), divisions], {level, 1, levels}], -1], {EdgeForm[Thick], color[[1]], Disk[{0, 0}, 1, {lowerlim, upperlim}]}];

  (* Display Graphic *)
  Show[Graphics[tree]]

  ],

 (* Manipulate components *)
 {{levels, 2, "Depth"}, 2, 15, 1},
 {{divisions, 2, "Subgroups"}, 2, 10, 1}, 
 {{lowerlim, 0, "Bound1"}, 0, (upperlim - Pi/6),  Pi/6}, 
 {{upperlim, 2 Pi, "Bound2"}, (lowerlim + Pi/6), 2 Pi, Pi/6}, 
 TrackedSymbols :> Manipulate
 ]

Using Polygon to create a Graphic Primitive

Yes, I could create a polygon primitive to generate the ring...

ring[outter_, inner_, size_, res_] := 
  Module[{p, q, outterPoints, innerPoints, partition},
   p = res;
   q = (size)/(2 Pi);
   outterPoints = 
    Table[{outter Cos[ k q 2 Pi/p], outter Sin[ k q 2 Pi/p]}, {k, 1, 
      p}];
   innerPoints = 
    Table[{inner Cos[ k q 2 Pi/p], inner Sin[ k q 2 Pi/p]}, {k, 1, p}];
   partition = 
    Polygon[Flatten[{outterPoints, Reverse@innerPoints}, 1]];
   Return[partition]
   ];

Then running using this, or something similar.

 Graphics[ring[2, 1, Pi/2, 3000]]

to generate this:

Then I could either rotate or change the primitive for the specific positioning, but I'd prefer if there were some way to do it based on the built-in functions of Mathematica.

Answer 1

An alternative approach is to use a custom ChartElementFunction. For example:

ClearAll[chrtElmntDtFnc];
chrtElmntDtFnc[datafunc_: ChartElementDataFunction["Sector"]][s_: (1/2)][{{t0_, t1_},
  {r0_, r1_}}, y_, {"none"}] := {};
chrtElmntDtFnc[datafunc_: ChartElementDataFunction["Sector"]][s_: (1/2)][{{t0_, t1_},
 {r0_, r1_}}, y_, z___] :=  datafunc[{{s t0, s t1}, {r0, r1}}, y, z];

Usage examples:

data = {{1}, {1, 1}, {2, 2, 1 -> "none", 1, 1, 1}, 
    {1, 1, 1, 1,  2 -> "none", 2 -> "none", 2 -> "none", 1, 1, 2, 2 -> "none"}};
datafuncs = {ChartElementDataFunction["Sector"],
 ChartElementDataFunction["GradientSector",
   "ColorScheme" -> "SolarColors", "GradientDirection" -> "Radial"],
 ChartElementDataFunction["OscillatingSector",
    "AngularFrequency" -> 6, "RadialAmplitude" -> 0.21`], 
 ChartElementDataFunction["SquareWaveSector", 
    "AngularFrequency" -> 50, "RadialAmplitude" -> 0.1`], 
 ChartElementDataFunction["NoiseSector",
    "AngularFrequency" -> 13, "RadialAmplitude" -> 0.16`], 
 ChartElementDataFunction["TriangleWaveSector", 
    "AngularFrequency" -> 18, "RadialAmplitude" -> 0.1`] };

 Grid[Partition[Table[PieChart[data, SectorOrigin -> {{2 Pi}, 0},
     ChartElementFunction -> chrtElmntDtFnc[i][1/2], ImageSize -> 300],
    {i, datafuncs}], 3], Spacings -> {0, -5}]

 Grid[Partition[Table[PieChart[data,
   SectorOrigin -> {{0, "Counterclockwise"}, 0},
   ChartElementFunction -> chrtElmntDtFnc[i][1/4], 
   ImageSize -> 300],
 {i, datafuncs}], 3], Spacings -> {-5, -5}]

... and removing the first element of data ({1}) and setting s=1, SectorOrigin -> {{2 Pi}, 1}:

Answer 2

Update

The new Mathematica 10.2 function Annulus offers the same functionality as the annulusDisk function defined below.

---

The code I used to generate a circular arc primitive for 3D graphics (splineCircle from this answer) can be used to make an efficient disk with annulus too. I use FilledCurve (new in Version 8) to combine two arcs that are build using NURBS curves. The code is slightly less straightforward than I had hoped for. This is due to the way FilledCurve combines first and last points of the various sections. I thought it could be done in a two-liner, but I ended up with a six-liner:

Clear[annulusDisk];
annulusDisk[m_List, {r1_, r2_}, {begin_, end_}] :=
 Module[{sc1, sc2, f2},
   sc1 = splineCircle[m, r1, {begin, end}];
   sc2 = splineCircle[m, r2, {begin, end}];
   f2 = First@Reverse@sc2[[1]];
   sc2[[1]] = Rest@Reverse@sc2[[1]];
   sc2[[4, 2]] = Reverse@sc2[[4, 2]];
   FilledCurve[{sc1, Line[{Last@sc1[[1]], Last@sc1[[1]], f2}], sc2}]
 ]

Graphics[{annulusDisk[{0, 0}, {1, 2}, {0, 5}]}]

Double clicking to see that the underlying structure is indeed simple and efficient:

Just a few control points is all there is.

Another demo:

Graphics[
 Table[
  {
   Opacity[RandomReal[{0.1, 1}]],
   Hue[RandomReal[]],
   annulusDisk[RandomReal[{-5, 5}, 2], RandomReal[{.25, 2}, 2], 
    RandomReal[{0, 2 π}, 2]]
   },
  {100}
  ]
 ]

Or, somewhat closer to the task at hand:

ImageResize[
 Graphics[
  Table[
   {
    c = ColorData["DeepSeaColors"][(r - 1)/9];
    FaceForm[c], EdgeForm[Darker@c],
    annulusDisk[{0, 0}, {r, r + 1}, #] & /@ 
     RandomSample[Partition[Range[0, 2 π, π/5] // N, 2, 1], 7]
    },
   {r, 1, 10}
   ], ImageSize -> 2000
  ], 600]

Answer 3

Have you looked at SectorChart? Here's one approach using RegionPlot. Note that because of the range of values ArcTan returns, you should specify angles between -Pi and Pi:

SegmentPlot[segmentList_, options : OptionsPattern[]] := 
  Module[{segmentInequalities, max},
   max = Max[Last /@ segmentList];
   segmentInequalities = # /. {
        {a1_, a2_, d1_, d2_} /; a2 < a1 :> 
         Not[a2 <= ArcTan[x, y] <= a1] && d1^2 <= x^2 + y^2 <= d2^2,
        {a1_, a2_, d1_, d2_} :> 
         a1 <= ArcTan[x, y] <= a2 && d1^2 <= x^2 + y^2 <= d2^2}
      & /@ segmentList;

   RegionPlot[segmentInequalities, {x, -max, max}, {y, -max, max}, 
    options]
   ];

SegmentPlot[{
  {-Pi, 0, .25, .5},
  {0, Pi, 1, 2},
  {-Pi/2, Pi/2, 2, 2.5},
  {Pi/2, -Pi/2, 3, 4},
  {Pi - Pi/8, -Pi + Pi/8, 1.5, 2.5}
  }, PlotPoints -> 50, Frame -> None]

A general note is that Transparent is considered a color, which might help in case you're layering things on top of one another using built-in functions.

Answer 4

Perhaps this is an obvious observation, but anyway.

You said:

I am currently doing this with the Disk[] primitive, but this requires me to build it up from the ground (outside) instead of the top (inside) so that they stack properly and the inner layers are visible.

That is not quite true.

Imagine you've swept your tree top down, so you got something like this:

l = {{FaceForm[Green], Disk[{0, 0}, 3, {0, Pi/8}], Disk[{0, 0}, 3, {Pi/4, Pi (1/8 + 1/4)}]},
    {FaceForm[Blue],   Disk[{0, 0}, 2, {0, Pi/4}], Disk[{0, 0}, 2, {Pi/4, Pi/2}]},
    {FaceForm[Red],    Disk[{0, 0}, 1, {0, 2 Pi}]}}
Graphics@l

Now, just doing

Graphics[Join[{EdgeForm[{Thick, Black}]}, Reverse@l]]

you get

Just hope this is not too stupid ...

Answer 5

You can use PieChart by creating segments for the "missing" children and styling those segments explicitly to be invisible:

PieChart[{{12}, {6, 6}, {2, 2, 2, 6}, {1, 1, 1, 1, 
   Style[8, Directive[EdgeForm[], Opacity[0]]]}}, SectorSpacing -> 0, 
 ChartBaseStyle -> EdgeForm[Black], 
 ChartStyle -> {{Darker@Purple, Purple, Lighter@Purple}}]

So the trick is just to map your tree data into integers representing the number of "theoretical" children the nodes at that level have. (I'm working on that bit - will update later.)

If you want a hole in the middle, then you need the SectorOrigin option:

PieChart[{{12}, {6, 6}, {2, 2, 2, 6}, {1, 1, 1, 1, 
   Style[8, Directive[EdgeForm[], Opacity[0]]]}}, SectorSpacing -> 0, 
 ChartBaseStyle -> EdgeForm[Black], SectorOrigin -> {Automatic, 1}, 
 ChartStyle -> {{Darker@Purple, Purple, Lighter@Purple}}]

Answer 6

This is a bit too long for a comment, so I'm posting this as an answer. Here's a slight simplification of amr's SegmentPlot[]:

SegmentPlot[segmentList_, options___] := 
 Graphics[Transpose[{Directive[Opacity[0.2, ColorData[1, #]], 
       EdgeForm[ColorData[1, #]]] & /@ Range[Length[segmentList]], 
    Function[circ, Polygon[Join[#4 circ, #3 Reverse[circ]]]][
       First[Cases[
         ParametricPlot[{Cos[u], Sin[u]}, {u, #1, #2}, 
          Evaluate[FilterRules[{options}, Options[ParametricPlot]]]], 
         Line[l_] :> l, Infinity]]] & @@@ segmentList}], 
  FilterRules[{options}, Options[Graphics]]]

Try it out:

SegmentPlot[{{-Pi, 0, .25, .5}, {0, Pi, 1, 2}, {-Pi/2, Pi/2, 2, 
   2.5}, {Pi/2, 3 Pi/2, 3, 4}, {Pi - Pi/8, Pi + Pi/8, 1.5, 2.5}}]