7
$\begingroup$

I'm having trouble figuring out a way to analyze some simple data. When graphed, the data I have make a somewhat sinusoidal curve. What I want to do is to find the x-values of the maximum peaks of the sinusoidal curve. I then want to subtract each of these x-values from the last peak found and average these differences to obtain an average distance between peaks. Is there an easy way to do this with Mathematica ? Any suggestions ?

$\endgroup$
  • 2
    $\begingroup$ Do you have the data as a discrete series of values, or as a known function f(x)? $\endgroup$ – Michael Seifert Apr 17 '15 at 19:32
  • $\begingroup$ It's a discrete series of values. Thanks everyone for your help! $\endgroup$ – Evan Hale Apr 18 '15 at 3:40
12
$\begingroup$

Using Bob Hanlon's example data:

data = Table[{x, Sin[x] + Sin[3. x/2]}, {x, 0, 6. Pi, Pi/5.}];

peaks = FindPeaks[data[[All,2]]][[All,1]]
(* {3,10,15,23,30} *)

Mean@Differences@peaks
(* 27/4 *)

Mean@Differences@data[[peaks, 1]]
(* 4.24115 *)

Or, use PeakDetect:

Mean @ Differences @ Pick[#1, PeakDetect @ #2, 1] & @@Transpose[data]
(* 4.24115 *)

Or, using @Michael Seifert's observation, you can also use

Subtract @@ data[[peaks[[{-1, 1}]], 1]]/(Length[peaks] - 1)
(* 4.24115 *)

Plots:

ListLinePlot[data,Epilog->{PointSize[Large], Red, Point@data[[peaks]]}]

enter image description here

ListLinePlot[data, 
  Epilog->{PointSize[Large], Red, Point@data[[peaks]],
     NumberLinePlot[Interval/@Partition[data[[peaks,1]],2,1],
  PlotStyle->Thickness[.01],Spacings->0][[1]]}]

enter image description here

ListLinePlot[data, ImageSize->400, 
 Epilog->{PointSize[Large], Red, Point@data[[peaks]]},
 Prolog->{NumberLinePlot[Interval/@
   Partition[data[[Join[{1},peaks,{Length[data]}],1]],2,1],
   PlotStyle-> Directive[PointSize[0], Opacity[.4], CapForm["Butt"], Thickness[1]], 
   Spacings->0][[1]]}]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks for introdrucing FindPeaks in combination with the elegant Part notation. $\endgroup$ – eldo Apr 17 '15 at 20:52
  • $\begingroup$ Woah! That exists!? $\endgroup$ – Ivan Apr 17 '15 at 21:04
  • $\begingroup$ @eldo thank you. Ivan it is one of those new-in version-10 things. So is NumberLinePlot. $\endgroup$ – kglr Apr 17 '15 at 21:14
  • $\begingroup$ Hi, thanks for your help. I'm having trouble getting FindPeaks[] to work with the 2D data I have ({x0,y0},{x1,y1}, etc.). Do you know a way to get it to work? $\endgroup$ – Evan Hale Apr 23 '15 at 4:46
  • $\begingroup$ @Evan, afaik FindPeaks and PeakDetect works only with a one-dimensional list as the first argument. Can't think of how to use FindPeaks to identify peaks in 2D data off the top of my head. That would make a great new question though. $\endgroup$ – kglr Apr 23 '15 at 7:47
12
$\begingroup$

Generating test data

data = Table[{x, Sin[x] + Sin[3. x/2]}, {x, 0, 6. Pi, Pi/5.}];

Clear[f]

The interpolation function for the data is

f = Interpolation[data];

Maxima occur for f'[x] == 0 and f''[x] < 0

xValues = x /. Select[
   FindRoot[f'[x], {x, #}] & /@
      Range[0, 6 Pi, Pi/4] //
     Union[#, SameTest ->
        (Abs[#1[[1, -1]] - #2[[1, -1]]] < 10^-4 &)] & //
    Quiet,
   f''[x] < 0 /. # &]

{1.24252, 5.65487, 8.96826, 13.8089, 18.2264}

Plot[f[x], {x, 0, 6 Pi}, 
 Epilog -> {Red, AbsolutePointSize[4], Point[{#, f[#]} & /@ xValues]}]

enter image description here

The separation between the maxima are

diff = Differences[xValues]

{4.41235, 3.31339, 4.84063, 4.41748}

Their average is

mu = Mean[diff]

4.24596

EDIT: However, this can be done more efficiently, particularly if the list is long. Looking at symbolic data,

dataS = Array[d, 10]

{d1, d[2], d[3], d[4], d[5], d[6], d[7], d[8], d[9], d[10]}

dataS // Differences // Mean

1/9 (-d1 + d[10])

So the Mean of the Differences just divides the interval into equal subintervals.

% == (dataS[[-1]] - dataS[[1]])/(Length[dataS] - 1)

True

mu == (xValues[[-1]] - xValues[[1]])/(Length[xValues] - 1)

True

$\endgroup$
2
$\begingroup$

If you don't need a precisely interpolated maximum value, you can just use the data set directly, as follows:

values = sampledata[[;; , 2]];
diffs = Differences[values];
selector = Table[If[diffs[[i]] > 0 && diffs[[i + 1]] < 0, 1, 0], {i, 1, 
    Length[diffs] - 1}];
maxima = Pick[Drop[Drop[sampledata, 1], -1], selector, 1]
avgmaxdist = (Last[maxima][[1]] - First[maxima][[1]])/(Length[maxima] - 1)

The idea here is to just calculate the differences between successive data points, and then look in the differences array for all of the positive elements that are followed by a negative element. Applying this to Bob Hanlon's sample data set yields

{{1.25664, 1.90211}, {5.65487, 0.221232}, {8.79646, 1.17557}, {13.823, 1.90211}, {18.2212, 0.221232}}

4.24115

The differing results are almost certainly due to the lack of interpolation in my code.

Note that the "average distance between maxima" is really the $x$-distance between the first and the last maximum, divided by the number of gaps between maxima. You still need to find all the maxima, though, so that you know how many there are.

$\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.