6
$\begingroup$

How can I plot a sequence of histograms, one after the other, in 3D? Here is an example enter image description here

$\endgroup$

2 Answers 2

10
$\begingroup$

When you have lots of data, you should consider using SmoothKernelDistribution or SmoothHistogram as I'm assuming that you must be thinking that the underlying true distribution is relatively smooth (and does not look like a jagged histogram).

These "nonparametric density estimates" work fine overlapped in 2D and if one really feels the need, one can create a 3D version much like what you've displayed for histograms.

(* Generate 4 sets of data *)
SeedRandom[12345];
data = RandomVariate[NormalDistribution[#[[1]], #[[2]]], 200] & /@ 
  {{0, 15}, {10, 12}, {20, 10}, {30, 5}};

(* Find smooth kernel density estimates *)
skd = SmoothKernelDistribution[#] & /@ data;

(* Plot resulting densities *)
ListPointPlot3D[Table[{10 (# - 1), x, PDF[skd[[#]], x]}, {x, -30, 50, .1}] & /@ {1, 2, 3, 4},
  Filling -> Bottom, BoxRatios -> {1, 1, 1}]

Multiple smoothed histograms in 3D

And the 2D version where the differences among curves is more readily apparent:

Plot[{PDF[skd[[1]], x], PDF[skd[[2]], x], PDF[skd[[3]], x], PDF[skd[[4]], x]},
  {x, -30, 50}, PlotLegends -> {"1", "2", "3", "4"}]

Multiple smooth histograms in 2D

$\endgroup$
8
$\begingroup$
data1 = RandomVariate[NormalDistribution[0, 1], 500];
data2 = RandomVariate[NormalDistribution[1, 1/2], 500];
data3 = RandomVariate[NormalDistribution[2, 2], 500];

Histogram3D with a custom ChartElementFunction

cef[{{xmin_, xmax_}, {ymin_, ymax_}, {zmin_, zmax_}}, ___] := 
 Polygon[{{xmin, ymin, zmin}, {xmax, ymin, zmin}, {xmax, ymin, zmax}, {xmin, ymin, zmax}}]

Histogram3D[MapIndexed[Thread[{#, #2[[1]]}] &, {data1, data2, data3}], 
 {{-6, 6, 0.2}, {1}},
 ChartStyle -> {Red, Green, Blue},  BoxRatios -> 1, Axes -> True, 
 Boxed -> False, Method -> {"Canvas" -> None}, 
 FaceGrids -> {{-1, 0, 0}, {0, 1, 0}, {0, 0, -1}}, 
 ChartElementFunction -> cef]

enter image description here

Post-process Histogram output to 3D histograms:

ClearAll[rectanglesTo3DPolygons ]
rectanglesTo3DPolygons = Module[{i = 1}, 
    Cases[#, {dir__, rects : {{{_Rectangle}} ..}} :> 
      With[{j = i++}, {dir, Opacity[.7], 
        EdgeForm[{Thin, White}], {rects[[All, 1, 1]] /. 
          Rectangle[{a_, b_}, {c_, d_}, o___] :> 
           Polygon[{{a, j, b}, {c, j, b}, {c, j, d}, {a, j, d}}]}}], {0, Infinity}]] &;


hist = Histogram[{data1, data2, data3}, {.2},  
  ChartStyle -> {Red, Green, Blue}, ImageSize -> 300];

facegrids = {{{1, 0, 0}, {Range[3], {1}}}, {{-1, 0,  0}, {Range[3], {1}}},
  {{0, 0, 1}, {{}, Range[3]}}, {{0,  0, -1}, {{},Range[3]}}};

hist3d = Graphics3D[rectanglesTo3DPolygons@hist, 
   PlotRange -> {Automatic, {0, 4}, All}, BoxRatios -> 1, 
   FaceGrids -> facegrids, ImageSize -> 300];

Row[{hist, hist3d}]

enter image description here

hist2 = Histogram[{data1, data3}, {.2}, ChartStyle -> {Red,  Blue}, 
  ImageSize -> 300]; 
hist3d2 = Graphics3D[rectanglesTo3DPolygons@hist2, 
  PlotRange -> {Automatic, {0, 3}, All}, BoxRatios -> 1, 
  FaceGrids -> facegrids, ImageSize -> 300];

Row[{hist2, hist3d2}]

enter image description here

BarChart with a custom ChartElementFunction

heights = HistogramList[#, {-6, 6, .2}][[2]] & /@ {data1, data2, data3};

BarChart3D[heights, ChartLayout -> "Grid", 
 ChartStyle -> {{Red, Green, Blue}, None}, BarSpacing -> {0, 1}, 
 BoxRatios -> 1, Axes -> True, Boxed -> False, 
 Method -> {"Canvas" -> None}, 
 FaceGrids -> {{-1, 0, 0}, {0, 1, 0}, {0, 0, -1}}, 
 ChartElementFunction -> cef, PlotRangePadding -> {0, 2, 0}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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