Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

Normal Look

(* Names have been removed. *)

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

Ring Look

(* 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:

Ring section

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.

share|improve this question

6 Answers 6

up vote 20 down vote accepted

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}]

enter image description here

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

enter image description here

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

enter image description here

share|improve this answer
2  
Wicked stuff!!! –  cormullion Sep 22 '12 at 9:09
    
@cormullion, agreed! –  MRN16 Sep 24 '12 at 12:09
    
@kguler, I think this is the most simplistic way to generate what I was thinking if the end design is a plot. Very nice demonstration of the versatility inherent in the function. –  MRN16 Sep 24 '12 at 12:09
    
@cormullion, thank you. MRN16, thanks for the accept. Especially thank you for a great question that inspired a general solution like Sjoerd's. –  kguler Sep 24 '12 at 21:59

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

Mathematica graphics

Now, just doing

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

you get

Mathematica graphics

Just hope this is not too stupid ...

share|improve this answer
    
Absolutely not! (stupid that is), In fact that's what I ended up doing in the end (as it was much simpler). I guess I shouldn't have posted the background info for my project since my real question was related to the generation of a Disk sector with a removed annulus. Thanks for the post though –  MRN16 Sep 22 '12 at 4:54

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]

enter image description here

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.

share|improve this answer

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}}]

enter image description here

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}}]

enter image description here

share|improve this answer

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}}]

SegmentPlot[] example

share|improve this answer
    
I suppose I could have used FilledCurve[]+BSplineCurve[]; the code would be a bit longer, but at least the primitives are simpler... –  J. M. Sep 22 '12 at 2:40

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}]}]

Mathematica graphics

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

Mathematica graphics

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 \[Pi]}, 2]]
   },
  {100}
  ]
 ]

Mathematica graphics

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 \[Pi], \[Pi]/5] // N, 2, 1], 7]
    },
   {r, 1, 10}
   ], ImageSize -> 2000
  ], 600]

Mathematica graphics

share|improve this answer
    
A very elegant way of generating the sectors, but the splineCircle code is quite a bit more than I was expecting before clicking the link. I like this though. Nice job! –  MRN16 Sep 24 '12 at 12:05
    
@MRN16 Thanks! Your intriguing question took more effort than I anticipated and I ended up posting the other question just to get a reasonable spot for the developed code that could serve a more generic purpose. It's not really big, just half a screen and it can be conventiently put in a package that you can include in a single line. –  Sjoerd C. de Vries Sep 24 '12 at 14:14
    
The spline is a very nice solution, don't get me wrong, especially for a 3D deployment as shown in the other question, very effective. but since the case I'm dealing with is only a 2D render the spline just seems un-necessary (lol). But it is an alternative way of approaching the issue, which is what I'm asking for so, thank you! As I said before, I really like this solution. –  MRN16 Sep 24 '12 at 15:45
    
Also, I haven't tried it, but if I were generating a vast plot or a lot of sectors, this would probably be the better solution to a polygon in terms of rendering and output. You've actually given me quite a bit to think about now... –  MRN16 Sep 24 '12 at 15:50

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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