A better alternative to the paired bar chart

Question

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:

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

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

Answer 1

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]

Answer 2

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

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.

Answer 3

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

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