Creating a highly customized BarChart

Question

I am trying to create a BarChart visualization for multi-step data filtering. Think of a traditional sales funnel: many leads, fewer prospects, few customers, very few return customers. The only kicker is, I want to show the percentage of data being lost by using Percentile layout for the BarChart, and I want to show that the slice of previous bar is the entirety of the content of the next bar using lines similar to Joined option, and if possible, fill the joining lines with color similar to the one used for selection. Lastly,for my data content, there are 2 types of filters: binary (e.g. lead becomes prospect or not) and slice-of-pie (e.g. customers who spent between X and Y, where the slice would appear in the middle of the column, with rest of sales with lower amount appearing below, and higher amount appearing above). I can draw this using Graphics and basic primitives, but was really hoping that there's a clever way to adapt BarChart, so that I could use the built-in labeling or legending features, as well as the vertical axis. Or even go from Percentile to Stacked, as needed.

Here's a simple drawing of what I envision this could look like:

And if anyone can suggest an alternate visualization which will serve the purpose, I'd really appreciate it. I thought of using TreeGraph with VertexSize option, but it's less than trivial to visualize not only what made it into the filter, but also how much are you losing and where the loss occurs.

UPDATE:

Thanks to @Verbeia's clever solution, and a little bit of additional engineering, this is what I came up with. Clearly there's endless room for improvement, but the automation works great.

data = {{4, 3, 4.5, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 3, 5, 6, 0, 
    0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 2, 3, 0, 0, 0}, {0, 0, 0, 0,
     0, 0, 0, 0, 0, 1, 1, 1}};
lines = Flatten[Table[{
     {{1.501 n, 
       100 data[[n, 3 n - 2]]/Total@data[[n]]}, {1.5 n + .499, 
       0}}, {{1.501 n, 
       100 (data[[n, 3 n - 2]] + data[[n, 3 n - 1]])/
        Total@data[[n]]}, {1.5 n + .499, 100}}}
    , {n, 1, 3}], 1];

Show[
  BarChart[data, ChartLayout -> "Percentile", 
   BarSpacing -> {None, .5}, ChartStyle -> "Pastel"],
  ListLinePlot[lines, 
   Filling -> 
    Table[(2 n - 1) -> {{2 n}, 
       Directive[[email protected], 
        ColorData["Pastel"][(3 n - 2)/(3 4)]]}, {n, 1, 3}], 
   PlotStyle -> Directive[Dashed, Gray]]
  , ImageSize -> 850]

And the result:

Answer 1

The built-in Joined option to BarChart doesn't really do what you want. So what I'd suggest is overlaying a BarChart on a ListLinePlot that creates the lines. Here is a simplified two-stacks-of-bars version.

data = {{4, 3, 0, 0, 4.5}, {0, 3, 5, 6, 0}};

The first point is that you will need to have zero-value elements in the bar chart data to ensure you get different coloring in the different stacks, or else use Style explicitly to customise the coloring in each stack.

Then you need to come up with lines that draw between the bars. This might be able to be automated, but it would require knowledge of which bar segments are the ones that "expand" to the next stack, as well as the BarSpacing option value in the BarChart, which determines the horizontal coordinates of the bars.

lines = {{{1, 100 data[[1, 1]]/Total[data[[1]] ]}, {1.5, 
 100 data[[1, 1]]/Total[data[[1]] ]}, {1.7, 0}}, 
{{1, 100 (data[[1, 1]] + data[[1, 2]])/Total[data[[1]] ]}, 
{1.5, 100 (data[[1, 1]] + data[[1, 2]])/Total[data[[1]] ]}, {1.7,  100}}};

Putting them together is fairly straightforward, but watch the PlotRange and Filling options in the ListLinePlot function:

Show[ListLinePlot[lines, PlotRange -> {{0, 3}, {0, 101}}, Filling -> {2 -> {1}}],
 BarChart[data, ChartLayout -> "Percentile"]]

Answer 2

A custom BarChart that takes as input a dataset accepted by BarChart and the index of the element in each group that fans out to the next group:

ClearAll[ceF, funnelBarChart]
ceF[cedf_: "GlassRectangle", o : OptionsPattern[]] := 
 Module[{color = Charting`ChartStyleInformation["Color"], 
  spacing = If[#3 === {}, 0, #3[[1, 2]]],
  next = If[#3 === {}, 0, If[#3[[1, 3]] === "Percentile", 100, 
   If[Head[#3[[1, 1, 1]]] === Style, Total[#3[[1, 1]][[All, 1]]], Total[#3[[1, 1]]]] ]]},
 {ChartElementDataFunction[cedf, o][##], 
    Lighter@Lighter@color, EdgeForm[{Darker@color, Dashed}], 
    If[#3 === {}, {}, Polygon[{{#[[1, 2]], #[[2, 1]]}, {#[[1, 2]], #[[2, 2]]}, 
    {#[[1, 2]] + spacing, next}, {#[[1, 2]] + spacing, 0}}]]}] &

funnelBarChart[data_, pieces_, layout_: "Stacked", spacing_: .5, 
  cef_: (ceF[])][o : OptionsPattern[]] := Module[{d2 = data}, 
  Table[d2[[i, pieces[[i]]]] = (data[[i, pieces[[i]]]] -> {data[[i + 1]], 
       spacing, layout}), {i, Length[data] - 1}];
  BarChart[d2, Frame -> True, ChartLayout -> layout, 
   BarSpacing -> {0, spacing}, ChartElementFunction -> cef, o, 
   ImageSize -> 500, ImagePadding -> 25]]

Examples:

data = {{4, 2, 3, 5}, {6, 7, 8}, Range[4, 6]}

Row[funnelBarChart[data, {#, 2}][ColorFunction -> "Pastel"] & /@ {2, 3}]

Row[funnelBarChart[data, {#, 2}, "Percentile"][ColorFunction -> "Pastel"] & /@ {4, 3}]

SeedRandom[1]
data2 = Style[#, Hue[RandomReal[]]] & /@ # & /@ data;
Row[funnelBarChart[data2, {#, 2}][] & /@ {2, 3}]

i = 1; 
data3 = Map[Style[#, ColorData[60, "ColorList"][[i++]]] &, data, {-1}];
Row[funnelBarChart[data3, {#, 2}][] & /@ {2, 3}]