# How do I generate a 3d histogram of runs

This question is an extension of the question I asked here Histogram of runs.

What I would like to do now is generate a Histogram3D that has the run duration on the x axis and the mean level on the y axis. The code given by kguler and VF1 in the previous post generate the duration that I need but I've been having trouble modifying the code to get the mean value along with the run duration.

Any help would be greatly appreciated.

This is a plot of the input data;

This is a plot of the 3d histogram using VF1s code;

• Have you made any effort to extend their answers to 3D? – rm -rf Nov 20 '12 at 23:17
• The 3d plot is not the issue. It's modifying the code to generate mean values for runs. – Cam Nov 20 '12 at 23:20

Regarding my answer to your previous question, in this step:

level = 1;
data3 = Module[{start, duration},
Cases[Split[data2, Last[#1] < level && Last[#2] < level &],
x_ /; Last[Last[x]] < level :>
{
start = x[[1, 2]],
DatePlus[start, {duration = Total[First /@ x], "Minute"}],
duration
}
]
]


A simple modification results in the desired values (Edit - additionally, as requested in the comments below by @Cam, I also added a generic test function):

test = # < 1 &;
data3 = Module[{start, duration},
Cases[Split[data2, test@Last[#1] && test@Last[#2] &],
x_ /; test@Last[Last[x]] :>
{
start = x[[1, 2]],
DatePlus[start, {duration = Total[First /@ x], "Minute"}],
Mean[Last /@ x],
duration
}
]
]


This gives a list of values {start time, end time, run level mean, duration}, which you can extract from on your histogram as necessary.

Again, using AbsoluteTime instead of DatePlus will be faster like before.

• I've got it working. I modified data3 to make all the tests > level (I'm counting the positive runs now). Is there any way to make that a generic test so you can specify something like #>1& ? – Cam Nov 20 '12 at 23:51
• Changing to AbsoluteTime reduced to run time from about 3 minutes to 0.7 seconds! – Cam Nov 21 '12 at 0:59

This is a modified version of the function in the linked Q/A to collect duration and mean values from a time-series list:

 ClearAll[durationsAndMeansF];
durationsAndMeansF[ts : {{{__}, _} ..}, testfunc_,
timeunit :  Alternatives @@ {"Week", "Day", "Hour", "Minute"} : "Minute"] :=
With[{units = (timeunit /. Thread[{"Week", "Day", "Hour", "Minute"} ->
{7 24 60 60, 24 60 60, 60 60, 60}])},
{{First@#, Last@#} &@(AbsoluteTime /@ #[[1]]),
(1/(units)) (Last@# - First@#) &@(AbsoluteTime /@ #[[1]]),
Mean@Drop[#[[2]], -1]} &@
Transpose[#] & /@ Select[Split[ts, testfunc], Length[#] > 1 &]]


Usage examples:

 opdata= {{{2010, 1, 1, 6, 15, 0.}, 0.04375},
{{2010, 1, 1, 6, 30, 0.}, 0.04375}, {{2010, 1, 1, 6, 45, 0.},  0.04375},
{{2010, 1, 1, 7, 0, 0.}, 5}, {{2010, 1, 1, 7, 15, 0.}, 0.5},
{{2010, 1, 1, 7, 30, 0.}, 5}};
durationsAndMeansF[data, #[[2]] <= 1 &,"Minute"]
(* {{{3471315300, 3471318000}, 45, 0.04375}, {{3471318900, 3471319800}, 15, 0.5}} *)


New York weather:

 nyWthr = WeatherData["NewYork", "Temperature", {{2012, 1, 1}, {2012, 1, 10}}];
Show[DateListPlot[nyWthr, GridLines -> {Automatic, {2, 5}},
PlotRange -> {-10, 20}, Joined -> True, ImageSize -> 800, AspectRatio -> 1/4],
DateListPlot[(Partition[Riffle[First@#, {Last@#, Last@#}], 2] & /@
durationsAndMeansF[nyWthr, 2 < #[[2]] < 5 &, "Minute"]),
Joined -> True, PlotStyle -> Thickness[.005],
ColorFunction -> (ColorData[1, "ColorList"][#] &)]]


 DateListPlot[Partition[Riffle[First@#, {0, 0}], 2] & /@
durationsAndMeansF[nyWthr, 2 < #[[2]] < 5 &, "Minute"],
Joined -> True, PlotStyle -> Directive[CapForm[None], Thickness[.05]],
Frame -> False, Axes -> False,
PlotRange -> {-1, 1}, ImageSize -> 800, AspectRatio -> 1/10]


histogramData =  durationsAndMeansF[nyWthr, 2 < #[[2]] < 5 &,
"Minute"][[All, {2, 3}]];
Histogram3D[histogramData, {5, 5}, "Count",
ChartElementFunction -> ChartElementDataFunction["ProfileCube",
"Profile" -> 2.5, "TaperRatio" -> 0.8],
ColorFunction -> ColorData["TemperatureMap"],
ChartStyle -> {Opacity[.7]}]