Histogram with the smaller bar in front

Question

I am trying to visualise multiple data sets in one histogram. When using one or two datasets, the automatic transparency of the bars keeps everything relatively easy to see. When going to three or more datasets however, quickly the colours become confusing and unclear, in particular when there is much overlap.

data = {RandomVariate[NormalDistribution[2, 2], 200], 
   RandomVariate[NormalDistribution[6, 2], 200], 
   RandomVariate[NormalDistribution[4, 3], 200]};
Histogram[data, ChartStyle -> {Blue, Green, Red}]

Instead of the transparency and the overlay of the colours, one can disable the transparency. The result of this however is that smaller bars can get hidden behind larger ones. Is there a way to make sure that the smallest bar in a certain bin is always in front of the larger ones? I have looked but all I found is the "Stacked" option of ChartLayout which is not what I am looking for.

Answer 1

k = Histogram[Tooltip[#, False] & /@ data, ChartStyle -> {Blue, Green, Red}]

(k /. {_[_[{_[_[_[{_, RectangleBox[a___]}]], _]}, _], _]} :> Rectangle[a]) /. 
{_[___, _[c : RGBColor[__]]], b : {Rectangle[__] ..}} :> Thread[{c, b}] /.
{{{}, s : {{RGBColor[__], Rectangle[__]} ..}, __}} :> s /.
{s : {RGBColor[__], Rectangle[__]} ..} .. :> s /. 
s : {{RGBColor[__], Rectangle[__]} ..} :> 
                           (SortBy[#, -#[[2, 2, 2]] &] & /@ GatherBy[s, #[[2, 1]] &])

Answer 2

So I dug up a function I had written to create a custom histogram, and have modified it to do the task here.

sortedHistogram[data_, colorlist_, labellist_, 
  plotopts : OptionsPattern[]] := 
 Module[{bins, bincounts, width, rectangles},
  (* Check that you have given a color and label for each data set *)

    If[Not@SameQ[Length[data], Length@colorlist, Length@labellist],
   Print["List dimensions not equal"];
   Abort[];
   ];
  (*Next we get the bins that would result from doing a histogram on \
the entire data set *)
  bins = HistogramList[Flatten@data][[1]];
  (* Then we get the bincounts for the individual data sets *)

  bincounts = Last@HistogramList[#, {bins}] & /@ data;
  width = First@Differences@bins;
  (* Create an array of rectangles *)

  rectangles = 
   Function[{color, 
      heights}, {EdgeForm[Black], color, 
        Rectangle[{#1 - 0.5 width, 0}, {#1 + 0.5 width, #2}]} & @@@ 
      Transpose[{Mean /@ (Partition[bins, 2, 1]), heights}]] @@@ 
    Transpose[{colorlist, bincounts}];
  (* Then sort them, putting the smallest in front.  
  This involves a transpose, sort, transpose sequence *)

  rectangles = 
   Transpose[
    Sort[#, #1[[3, 2, 2]] > #2[[3, 2, 2]] &] & /@ 
     Transpose[rectangles]];
  (* Now we show the data, and I've included the legend by default *)

    Legended[
   Show[Graphics /@ rectangles, plotopts, Frame -> True, 
    AspectRatio -> 0.7],
   SwatchLegend[colorlist, labellist]
   ]
  ];

We'll try it on some test data,

data = RandomVariate[NormalDistribution[#1, #2], 300] & @@@ {{2, 
     2}, {6, 2}, {4, 3}, {0, 4}};

This is the default histogram,

Histogram[data, ChartStyle -> {Red, Blue, Green, Purple}]

And here is the sorted histogram,

sortedHistogram[data, {Red, Blue, Green, Purple}, {"label1", "label2",
   "label3", "label4"}]

You can give any graphics options to customize the plot,

sortedHistogram[data, {Red, Blue, Green, Purple}, {"label1", "label2",
   "label3", "label4"}, AspectRatio -> .5, ImageSize -> 500, 
 FrameLabel -> {"value", "frequency"}, BaseStyle -> 16]

However, the BaseStyle won't apply to the legend labels. To do that you need to give a Style object for the labels. For example instead of {"label1", "label2", "label3", "label4"}, put Style[#, 18, FontFamily -> "Times"] & /@ {"label1", "label2", "label3", "label4"}

Answer 3

One of the problems with your approach is that sometimes the larger bar and sometimes the smaller bar will be "in front." As such, I prefer seeing the data in 3D, especially for presentations (I can dynamically rotate the 3D figure for my audience) and reports:

z = Table[
   {i, RandomVariate[NormalDistribution[2, 2]]}, {i, 3}, {200}];
Histogram3D[z]

You mentioned the difficulty when there are more than three histograms.

Try this:

Histogram3D@Table[
  {i, RandomVariate[
    NormalDistribution[RandomReal[30], RandomReal[10]]]}, 
  {i, 10}, {200}]

or better yet:

mymeans = RandomReal[{1, 20}, 10];
mystandarddevs = RandomReal[{5, 20}, 10];
myfig = Histogram3D@Table[
   {i, RandomVariate[
     NormalDistribution[mymeans[[i]], mystandarddevs[[i]]]]}, 
   {i, 10}, {200}]