6
$\begingroup$

I have as example multiple lists of x data (in mm) http://pastebin.com/7xwgGDsd which I want to plot against time (in sec).

time = Table[t/60, {t, 1, number}] // N;
x = Get@"http://pastebin.com/raw/7xwgGDsd";

ListPlot[Transpose[{time, #}] & /@ Transpose[x], PlotRange -> Full, 
 Joined -> True, Frame -> True, 
 FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, ImageSize -> Large]

enter image description here

As next I calculate the moving average of each list:

xaverage = MovingAverage[#, 180] & /@ Transpose[x];
naverage = 
  Length@xaverage[[1, All]]; (*is same for each averaged list*)

ListPlot[Transpose[{time[[1 ;; naverage]], #}] & /@ xaverage, 
 PlotRange -> Full, Joined -> True, Frame -> True, 
 FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, ImageSize -> Large]

enter image description here

Finally I would like to put everything in one plot by using ListPlot to plot the x lists and if appropriate Epilog to plot the moving average lists.

To do that I tried the following, but it fails:

ListPlot[Transpose[{time, #}] & /@ Transpose[x], 
 Epilog -> {Thickness[0.002], Line[#] & /@ xavarage}, 
 PlotRange -> Full, Joined -> True, Frame -> True, 
 FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, ImageSize -> Large]

How can I solve this problem? (For my real data is Dimensions[x] = {2726, 10} -> 10 x data lists)

$\endgroup$
  • $\begingroup$ Why not use Show? $\endgroup$ – xslittlegrass May 30 '16 at 15:27
  • $\begingroup$ @xslittlegrass: can you show an example on how you would solve this with a variable number of lists (not only 2 data sets with average curves, but more)? The nice thing of ListPlot that it chooses different colors for each pair of raw and average data. $\endgroup$ – mrz May 30 '16 at 15:32
  • 2
    $\begingroup$ Why not go for TemporalData? If you take a look at Applications there, you will see how Showis used for multiple paths. $\endgroup$ – gwr May 30 '16 at 15:35
  • $\begingroup$ @gwr: This is interesting, I have to read the documentation and will try it out. $\endgroup$ – mrz May 30 '16 at 15:43
  • $\begingroup$ The variable numberis never defined here. Maybe you should change the question to make its value clear (e.g. as in my answer Length @ x?). $\endgroup$ – gwr May 31 '16 at 15:33
6
$\begingroup$

As a quick answer based upon TemporalData and the use of MovingMap:

x = Get@"http://pastebin.com/raw/7xwgGDsd";
time = Table[t/60, { t, 1, Length @ x }] // N; (* seconds *)

(* make these data TemporalData *)
td = TemporalData[Transpose[{time, #}] & /@ Transpose[x]];

$PlotTheme = "Scientific";
Show[ {
    ListLinePlot @ td, 
    ListLinePlot[ 
        MovingMap[ Mean, td, Quantity[180, "Events"] ], 
        PlotStyle -> Directive[Thin, Orange] 
    ]
  }, 
  ImageSize -> Large,
  FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}
]

MovingAveragesRight

Update

To shift the MovingAverage this specification of the window alignment for MovingMapcan be used:

Show[{
    ListLinePlot @ td, 
    ListLinePlot[ 
        MovingMap[ Mean, td, { Quantity[180, "Events"], Left } ],
        PlotStyle -> Directive[Thin, Orange]
    ]
  }, 
  ImageSize -> Large,
  FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}
]

MovingAveragesLeft

Update 2: Solution without Show

Since a lot of people seem to mistrust Show I would like to point out that there is no need for it:

augmentedTD = TemporalData[
    {
      td, (* the original time series *)
      MovingMap[ Mean, td, { Quantity[180, "Events"], Center } ] (* MovingAverages, centered *)
    }
]; 

ListLinePlot[
    augmentedTD, (* or augmentedTD["Paths"], augmentedTD["Path", 1], ... *)
    PlotTheme -> {"Scientific", "CoolColors", "LargeLabels" },
    ImageSize -> Large,
    FrameLabel -> {{"x (m)", None }, {"t (sec)", None }}]
]

MovingAveragesCentered

Note that, as pointed out in the comments, one can easily access each single time series by using augmentedTD["Path", i] where i ∈ [1,4].

$\endgroup$
  • $\begingroup$ Great, only one thing, can the average curves be shifted to left? Would this solution also work for many data sets (with only two lines in Show)? $\endgroup$ – mrz May 30 '16 at 16:05
  • $\begingroup$ Please note, that the MovingAveragemust have a gap since it uses 180 data points to come up with a value. Using TemporalDataand MovingMapwill be true to the times -- no streching of curves as in simply using ListPlot and Lists. My advice: If you have TimeSeries go for TimeSeries-Functionality - it is eventually safer to do so. $\endgroup$ – gwr May 30 '16 at 17:23
  • $\begingroup$ @mrz I have now updated my solution to demonstrate that Show is not needed which further demonstrates the power of the TemporalData framework. $\endgroup$ – gwr May 31 '16 at 14:53
  • $\begingroup$ How did you find all the possible units of Quantity, like "Events". What is t-step in which the t-window is moved? $\endgroup$ – lio Dec 30 '18 at 13:16
4
$\begingroup$

I've updated this answer in response to gwr's comments. The original answer can be found in the edit history.

I prefer to avoid using Show to combine multiple ListPlots when possible. @gwr makes a good point that one should leverage the time-based functions of Mathematica in cases where the data are temporal; however, it is still possible to achieve the desired output without using TemporalData

x = Get@"http://pastebin.com/raw/7xwgGDsd";
time = Table[t/60, {t, 1, Length@x}] // N;(*seconds*)
With[{data = Partition[Riffle[time, #], 2] & /@ Transpose[x]},
 ListPlot[Join[data, MovingAverage[#, 180] & /@ data], 
 Joined -> True, Frame -> True, 
 FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, 
 ImageSize -> Large]
]

enter image description here

Because a moving average will not be defined for the first and last n/2 points, your results should have "missing" data at both the beginning and end of the plot.

Note, in this answer, I am taking advantage of the uniform distribution of points in your dataset, so the (moving)average time at a particular point is equal to that time. I have not thought through whether or not this applies to a non-uniform distribution of points.

Interestingly, there is a subtle difference between the use of MovingMap[Mean,data,n] and MovingAverage[data,n] when applied to a list of {x,y} pairs. I'm not quite sure what the difference is, so be careful when interchanging them.

$\endgroup$
  • $\begingroup$ I like your solution ... it is may be not so "readable" as using TemporalData but it is the fastest ... $\endgroup$ – mrz May 30 '16 at 16:50
  • 1
    $\begingroup$ @mrz But we should note that the solution given with ListPlot alone is maybe not the truest solution: Note that MovingAverage produces 2547 data points while the original data have 2726 points. So there must be data missing for the moving averages (if placed left, then to the right). But there is no gap! If you remove DataRange here you will see the same result as given in the TemporalDatasolution - very tricky. What I like about TemporalDatais that it is completely true to your time information. $\endgroup$ – gwr May 30 '16 at 17:19
  • 1
    $\begingroup$ @gwr I agree. A correct answer would pass {x,y} pairs to ListPlot. I wanted to demonstrate that raw and processed data can all be passed as arguments without the need for epilog; and further, the processing can be done within ListPlot without having to assign a new symbol to the processed data. Doing it correctly would become less readable, however. $\endgroup$ – bobthechemist May 30 '16 at 21:46
  • $\begingroup$ I agree with that, but essentially - as of now - this is a readable, fast and wrong solution. Maybe one should assign some value to truth in scientific computing? :) $\endgroup$ – gwr May 31 '16 at 5:24
  • 1
    $\begingroup$ @gwr point well taken, and I have updated my answer in response to your comments. Can you comment on why your answer gives a value for the moving average at the end of the dataset? Should there be gaps at both the beginning and end? $\endgroup$ – bobthechemist May 31 '16 at 12:56
2
$\begingroup$

For version 9, there is TemporalData`EnsembleMovingMap:

x = Get@"http://pastebin.com/raw/7xwgGDsd";
time = Table[t/60, {t, 1, Length@x}] // N;
td = TemporalData[Transpose[{time, #}] & /@ Transpose[x]];

ListPlot[TemporalData[{td, TemporalData`EnsembleMovingMap[Mean, td, 180]}],
 Joined -> True, Frame -> True]

Mathematica graphics

If needed, wrap the moving map with TemporalData`ShiftTimes:

ListPlot[TemporalData[{td, 
   TemporalData`ShiftTimes[TemporalData`EnsembleMovingMap[Mean, td, 180], -3]}],
 Joined -> True, Frame -> True]

Mathematica graphics

$\endgroup$
0
$\begingroup$

Following the hint from xslittlegrass one can do also the following:

time = Table[t/60, {t, 1, number}] // N;
x << "http://pastebin.com/raw/7xwgGDsd";

nPoints = 180; (* Moving Average over 180 points*)
xaverage = MovingAverage[#, nPoints] & /@ Transpose[x];
naverage = 
 Length@xaverage[[1, All]]; (*is same for each averaged list*)

Show[
 ListLinePlot[Transpose[{time, #}] & /@ Transpose[x]], 
 ListLinePlot[
  Transpose[{time[[nPoints/2 ;; Length@time - nPoints/2]], #}] & /@ xaverage], 
 PlotRange -> All, Joined -> True, Frame -> True, 
 FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, ImageSize -> Large
]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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