How do I generate a 3d histogram of runs

Question

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;

Answer 1

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.

Answer 2

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]}]