9
$\begingroup$

In an nice blog post about the horrors of the paired bar chart, Jonathan Schwabish proposes an elegant alternative, as follows. Instead of having pairs of yellow and blue bars, simply plot their endpoints, connected by a thin grey line, like in this plot of Gini coefficients before and after tax:

enter image description here

For those who want to go full Tufte, there is even this:

enter image description here

It seems to me that there should be a way to modify BarChart to do this -- haven't been able to figure out how. Does anyone have any ideas about how to produce a plot like the first of the two plots above (or the second, for that matter)? Notice that these are categorical data.

Here are the data used in these graphs:

giniCoefficients =
 {{"United States", 4.2, 5.7},
  {"Israel", 4.1, 5.8},
  {"UK", 4.1, 6.3},
  {"Canada", 3.8, 5.5},
  {"Greece", 3.8, 6.0},
  {"Spain", 3.8, 5.7},
  {"Australia", 3.8, 5.5},
  {"Norway", 3.7, 5.7},
  {"Korea", 3.7, 4.4},
  {"Poland", 3.6, 6.5},
  {"Taiwan", 3.6, 4.2},
  {"Germany", 3.6, 6.0},
  {"Finland", 3.5, 5.8},
  {"Ireland", 3.5, 6.3},
  {"Slovak Republic", 3.5, 5.4},
  {"Japan", 3.5, 4.9},
  {"Austria", 3.3, 5.5},
  {"Netherlands", 3.3, 5.7},
  {"Sweden", 3.3, 5.7},
  {"Denmark", 3.3, 5.6},
  {"Luxemberg", 3.2, 5.2},
  {"Switzerland", 3.1, 4.7}
 }
$\endgroup$
  • $\begingroup$ Why not just use Graphics and Text? $\endgroup$ – Sjoerd C. de Vries Sep 5 '15 at 7:09
  • $\begingroup$ Yes, that would be straightforward enough. I was frustrated that I couldn't hack BarChart to do it. $\endgroup$ – Corvus Sep 5 '15 at 7:11
8
$\begingroup$

Here is a version that builds up the "full Tufte" version of the plot presented above by building up the corresponding Graphics primitives. Quite a few styling decisions must be made with respect to colors, spacings, overall aspect ratio of the plot, etc. I went with choices that were aesthetically pleasing to me, but of course it should be relatively easy to tweak those within the function.

The vertical sorting of the data points is also somewhat arbitrary. At this point the data is presented in such a way that the points with lowest first Gini coefficient show up at the bottom, and in the case of a tie, they are ordered by the alphabetical order of their labels (because of the way SortBy works). If that is undesirable, one should adjust the sorting function in SortBy: for instance, a stable sort such as SortBy[{#[[2]]&}] would leave tied elements in the original order in which they were present in the dataset, etc.

The horizontal PlotRange is adjusted somewhat automatically to include the labels as well by including an asymmetric PlotRangePadding in the $x$ direction. This is somewhat brittle because the length of the label strings is never taken into explicit consideration. I have the impression that there should be a combination of PlotRange / Padding / Clipping that could take care of that automatically, but at this moment it slips my mind.

fullTufte[dataset_] :=
 Graphics[
  Flatten@MapIndexed[
    Function[{item, index},
     {
      (*heading*)
      Black, Text[item[[1]], {item[[2]] - 0.35, First@index}, {1, 0}],
      (*line*)
      Gray, Line[{{item[[2]], First@index}, {item[[3]], First@index}}],
      (*numbers*)
      Darker@Blue, 
      Inset[item[[2]], {item[[2]], First@index}, {0, 0}, Background -> White],
      Orange, Inset[item[[3]], {item[[3]], First@index}, {0, 0}, Background -> White]
      }
     ],
    SortBy[#[[2]] &][dataset]
    ],
  PlotRange -> All, PlotRangeClipping -> False,
  PlotRangePadding -> {{Scaled[0.3], Scaled[0.05]}, Automatic},
  AspectRatio -> 1.6,
  Axes -> {True, False}
 ]

Here is the result of its application to the giniCoefficients dataset:

fullTufte[giniCoefficients]

graphics result

$\endgroup$
  • $\begingroup$ What a great function -- thank you! It's really beautiful. I'd love to see this style of plot replace paired bar charts more generally. I can think of relatively few cases where a paired bar chart is preferable. In some cases, when you want to really focus on the density of the bars themselves, the form used in Mathematica's PairedBarChart, with the bars on opposites of a central axis, may be acceptable. The obvious example is a population pyramid. $\endgroup$ – Corvus Sep 5 '15 at 23:31
4
$\begingroup$

In version 10+ there is NumberLinePlot that can be used for this.

NumberLinePlot[Interval[Rest@#] & /@ Reverse[giniCoefficients, 1], 
 PlotStyle -> (Directive[#, Thin, PointSize[Large]] & /@ {Orange, 
     Blue}),
 PlotRange -> {{2, Automatic}, Automatic},
 PlotRangePadding -> Scaled[.05],
 Epilog -> 
  MapIndexed[
   Function[{item, index}, 
    Inset[First@item, {item[[2]] - .05, First@index}, {1, 0}]], 
   Reverse[giniCoefficients, 1], 1]]

enter image description here

There are a couple of things that I don't know how to do that I'd like to be able to without a ReplaceAll hack on the plot.

  1. Find the length of the text in the graphic so a proper lower PlotRange can be set.
  2. Define a PlotStyle that gives either of the styles the OP requested.

Hopefully someone will add an answer with those features.

$\endgroup$
  • $\begingroup$ I'll just add that I tried to used Labeled on the Intervals but it was ignored in the plot. I think that would be a nice feature to have for NumberLinePlot since it is a line and the named positions for Labeled would work well for it. If there are any WRI eyes crossing this. $\endgroup$ – Edmund Sep 5 '15 at 13:11
1
$\begingroup$

RangeBarChart

With a custom ChartElementFunction we can use the built-in (undocumented) function Charting`RangeBarChart as follows:

ClearAll[ceF]
ceF[marker_: "Point"] := Module[{coords = Reverse /@ Thread[{Mean[#2], #}] & @@ #}, 
  {CapForm["Round"], Line[coords], PointSize[.02], 
   If[marker === "Point", {Blue, Point[coords[[1]]], Orange, Point[coords[[2]]]}, 
    {Text[Style[#[[1]], Blue, 12, Background -> White], #] &@ coords[[1]], 
     Text[Style[#[[1]], Orange, 12, Background -> White], #] &@ coords[[2]]}]}] &;

labeleddata = Labeled[{##2}, Style[ToString[#]<>"   ", 16], Before]&@@@ giniCoefficients;
options = {ChartElementFunction -> ceF[], BarOrigin -> Left, AspectRatio -> 1,
  Axes -> False, ImageSize -> 500, Frame -> {{False, False}, {True, False}}, 
  PlotRangePadding -> {{Automatic, Automatic}, {Scaled[.05], Scaled[.05]}}};

Panel[Quiet @ Charting`RangeBarChart[labeleddata, options]]

enter image description here

Change ceF[] to ceF[blah] in options to get

enter image description here

$\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.