How can I plot a sequence of histograms, one after the other, in 3D? Here is an example
2 Answers
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}]
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"}]
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]
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}]
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}]
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}]