Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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;

enter image description here

This is a plot of the 3d histogram using VF1s code; enter image description here

share|improve this question
    
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

2 Answers 2

up vote 2 down vote accepted

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.

share|improve this answer
    
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"][#] &)]]

enter image description here

 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]

enter image description here

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

enter image description here

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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