1
$\begingroup$
data2000 = Import["D:\\db_2000cm.xls"];
..
data50 = Import["D:\\db_50cm.xls"];

Histogram3D[
{data2000[[1]], data50[[1]]}, {{"Raw", 66}, {"Raw", 40}}, "Count",
PlotRange -> {{30, 100}, {0, 2100}, {0, 800}},

Ticks -> {
{30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 85, 90, 95},
{0, 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000},
{0, 200, 400, 600, 800}}]

Produces the following plot: enter image description here

Every dataset (of different number of samples) that I have available to add to this plot (right now I only have the max and min dataset which are 2000 and 50 respectively), corresponds to some value which is multiple of 50 (e.g. 2000, 1950.. down to 50). What I need is to always have a Y width of 50 for each dataset I add. With that said, the yellow distribution should start from 50 and end at 100 on y axis (or from 0 upto 50 in case this is easy), while the blue distro should start from 2000 and end to 2050 (or from 1950 and end to 2000 in case this is easy). How can I do that?

Let me also mention that the number of bins within each dataset should be 66 (i.e. from 30 up to 95 with increase of 1)

The inside of each XLS look like this:

enter image description here

$\endgroup$
0

2 Answers 2

3
$\begingroup$
nd = 40;
SeedRandom[1]
dts = RandomVariate[NormalDistribution[40 + #, 10], 
     RandomInteger[{500, 1000}]] & /@ Range[nd];

Length /@ dts
{918, 570, 594, 772, 823, 805, 685, 953, 967, 900, 804, 625, 616, 
874, 660, 793, 960, 899, 771, 1000, 800, 567, 950, 507, 789, 631, 
504, 588, 628, 788, 862, 561, 759, 560, 837, 898, 506, 978, 693, 971}
idts = MapIndexed[Thread[{#, 50 (#2[[1]])}] &, dts];

First 5 rows of the first data set:

idts[[1, ;; 5]] // Grid[#, Dividers -> All] &

enter image description here

Histogram3D[idts, {{"Raw", 66}, {"Raw", nd}}, "Count", 
 ImageSize -> 700, 
 ChartLegends -> {"data" <> ToString[50 #] & /@ Range[nd]}, 
 Ticks -> {Range[0, 100, 5], Range[0, 2000, 100], Automatic}]

enter image description here

To see the first 10 data sets in more detail:

Histogram3D[idts[[;; 10]], {{"Raw", 66}, {"Raw", 10}}, "Count", 
 ImageSize -> 700, 
 ChartLegends -> {"data" <> ToString[50 #] & /@ Range[10]}, 
 Ticks -> {Range[0, 100, 5], Range[0, 2000, 50], Automatic}]

enter image description here

To chart non-contiguous subsets of the 40 data sets, we need to change the bin specification for the y direction to {50} ( or to {50,2000,50}):

Histogram3D[idts[[{1, 5, 12, 20, 24}]], {{"Raw", 66}, {50}}, "Count", 
 ImageSize -> 700, 
 ChartLegends -> {"data" <> ToString[50 #] & /@ {1, 5, 12, 20, 24}}, 
 Ticks -> {Range[0, 100, 5], Range[0, 2000, 50], Automatic}]

enter image description here

To show only two of 40 datasets we need a trick (to work around a possible bug): add a third data set and set its style to None:

Histogram3D[idts[[{1, 40, 40}]], {{"Raw", 66}, {50}}, "Count", 
 ImageSize -> 700, 
 ChartStyle -> {{ ColorData[97] @ 1, ColorData[97] @ 40, None}}, 
 ChartLegends -> ("data" <> ToString[50 #] & /@ {1, 40}), 
 Ticks -> {Range[0, 100, 5], Range[0, 2000, 100], Automatic}]

enter image description here

The specification {"Raw", 66} gives 66 bins in x direction for the combined data set:

Length[HistogramList[Join @@ idts, {{"Raw", 66}, {"Raw", nd}}, "Count"][[1, 1]]] - 1
66

To get 66 bins for each data set, we can chart each set separately and combine the charts with Show:

Show[MapIndexed[Histogram3D[#, {{"Raw", 66}, {50}}, "Count", 
    ChartBaseStyle -> Opacity[.5], 
    ChartStyle -> ColorData[97][#2[[1]]], 
    ChartLegends -> {"data" <> ToString[50 #2[[1]]]}] &, idts[[;; 10]]], 
 PlotRange -> All, ImageSize -> 700, 
 Ticks -> {Range[0, 100, 5], Range[0, 2000, 50], Automatic}]

enter image description here

Alternative Visualizations:

SmoothHistogram3D

SmoothHistogram3D[Join @@ idts, MeshFunctions -> {#2 &}, 
  Mesh -> {{50 #, Directive[Thick, ColorData[{"Rainbow", {1, nd}}]@#]} & /@ 
     Range[nd]}, 
  PlotStyle -> None, BoundaryStyle -> None, 
  ImageSize -> Large, 
  PlotLegends -> LineLegend["Rainbow", "data" <> ToString[50 #] & /@ Range[nd]], 
  PlotRange -> {{0, 120}, Automatic, Automatic}, 
  Ticks -> {Range[0, 120, 10], Range[0, 2000, 100], Automatic}] /. 
 Line[x_] :> {Line[x], Opacity[.25], EdgeForm[], Polygon[x]}

enter image description here

BoxWhiskerChart

BoxWhiskerChart[dts, ChartStyle -> "Rainbow", 
 GridLines -> {None, Range[0, 120, 10]}, ImageSize -> 700 , 
 ChartLabels -> (Rotate[Row[{"data", 50 #}], 90 Degree] & /@ Range[nd]), 
 Joined -> True]

enter image description here

DistributionChart

DistributionChart[dts, ChartStyle -> "Rainbow", 
 GridLines -> {None, Range[0, 120, 10]}, 
 ChartElementFunction -> ChartElementDataFunction["SmoothDensity", 
   "Shape" -> "SingleSided"], 
 ImageSize -> 700 , 
 ChartLabels -> (Rotate[Row[{"data", 50 #}], 90 Degree] & /@ Range[nd])]

enter image description here

$\endgroup$
4
  • $\begingroup$ I feel I need to buy u a beer :D. May I ask.. I have my db looking like that now: gouz.tinytake.com/tt/NDcxMTAwM18xNDkxNDgzMw How can I load such xls in the same data structure as yours? (There are 40 columns there and around 10k rows) $\endgroup$
    – Gouz
    Oct 10, 2020 at 5:04
  • $\begingroup$ Or if it easier? How can I merge all the different tables I had before into the same data structure as idts? Same for me $\endgroup$
    – Gouz
    Oct 10, 2020 at 5:13
  • 1
    $\begingroup$ if the data is in sheet 1 in file foo.xls use dts = Import["foo.xls", {"Data", 1}]. $\endgroup$
    – kglr
    Oct 10, 2020 at 5:20
  • $\begingroup$ Thx m8. You got some good karma coming from some random side of this world :D. It worked $\endgroup$
    – Gouz
    Oct 10, 2020 at 6:27
1
$\begingroup$

It is the 21st century and one should jettison the lumpy histogram for continuous data. One can easily use SmoothHistogram. This also gets you appropriate "bin widths" for each set of data.

Using the data generated by @kglr one can create the smooth histograms and collect the data to plot the resulting curves:

sh = SmoothHistogram[#, Automatic, "PDF", PlotRange -> {{0, 120}, {0, 0.05}}] & /@ dts;
curves = Table[Flatten[{i, #}] & /@ Flatten[List @@ Cases[sh[[i]], _Line, Infinity][[1]], 1], 
  {i, nd}];

Now turn those curves into polygons and lines:

p = Table[Polygon @@ {curves[[i]]}, {i, nd}];
lines = Table[Line @@ {curves[[i]]}, {i, nd}];

Finally draw all of the smoothed histograms in a 3D plot:

Graphics3D[{EdgeForm[Thick], p, Black, lines}, BoxRatios -> {1, 1, 3/4},
  Axes -> True, AxesEdge -> {{1, 1}, {1, 1}, {1, 1}}]

Collection of 2D histograms

$\endgroup$

Your Answer

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

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