# Integrating curve peaks

I have curve with a set of peaks (black line in the figure below) and I have to calculate the area of each peak. At the end of each peak there is a short linear region. So to calculate peaks' area first I should calculate the curve which pass smoothly through all linear regions of my initial curve (red line). I know I should provide some code where I attempt to solve the problem, but I have no any idea how to do it, sorry.

I would like to precise that I need to calculate this red curve, but not just integrate. I need just model this calculations in Mathematica to reproduce it further using JavaScript.

Here is data for my curve

data = << "http://pastebin.com/raw/kAdkHpQn";


The shape of peaks could be very different. Moreover it could be several maximums inside one peak. The only definite thing is that there is linear region after each peak. A add some more examples of my curves

• – Michael E2 Aug 10 '16 at 22:10

data = << "http://pastebin.com/raw/kAdkHpQn";

ip = Interpolation[data];

base = FindPeaks[data[[All, 2]], 1, 0, 19.3] /. {x_, y_} -> {2 x, y};

ipBase = Interpolation[base, InterpolationOrder -> 1];

Plot[{ip[x], ipBase[x]}, {x, 2, 3298}, Epilog -> Point[base]]

ni = NIntegrate[ip[x], {x, 2, 3298}, MaxRecursion -> 25, Method -> {"GlobalAdaptive"}]
niBase = NIntegrate[ipBase[x], {x, 2, 3298}]

diff = niBase - ni


ni= 63855.3

niBase= 64013.6

diff= 158.27

• I need to calculate the area of each peak, but I also I really need to calculate the red curve, which I will also use for other purposes – Филипп Цветков Aug 10 '16 at 21:09
• @ФилиппЦветков Do you have the data for the Red line or is that part of what you are trying to find – Young Aug 10 '16 at 21:11
• No, I draw it by hands. I want to find this red line automatically – Филипп Цветков Aug 10 '16 at 21:13
• @ФилиппЦветков Take a look at my update – Young Aug 10 '16 at 21:37
• Very close. Thank you! – Филипп Цветков Aug 10 '16 at 21:53

Here is something to get you started,

{xvals, yvals} = Transpose@data;
yvals = -yvals;
background = EstimatedBackground[yvals,20];
ListLinePlot[
{yvals, background},
DataRange -> MinMax@xvals,
PlotRange -> All]


Now you have the background, let's find the peaks:

peaks = {xvals[[#1]], #2} & @@@
FindPeaks[yvals - background, 10]
(* {{76., 0.0565933}, {294., 0.422362}, {494.,
0.337809}, {694., 0.315474}, {894., 0.305115}, {1094.,
0.294088}, {1294., 0.287829}, {1494., 0.281396}, {1694.,
0.278064}, {1896., 0.264395}, {2096., 0.258708}, {2296.,
0.253219}, {2496., 0.254073}, {2696., 0.247036}, {2896.,
0.24627}, {3096., 0.236166}, {3296., 0.231089}} *)


Take a look to make sure you found all the peaks:

ListLinePlot[yvals - background,
DataRange -> MinMax@xvals,
Epilog -> {Red, PointSize[Large], Point@peaks}]


Now if I wanted to find the peak areas, I might try to fit this data to a functional form, perhaps a Gaussian for each peak, or a Lorentzian. Have a look at FindFit

Of course, you could do it purely numerically by integrating an interpolating function between the midpoints of all the peaks...

interp = Interpolation[Thread[{xvals, yvals - background}]];
midpoints =
Join[{First@xvals}, Mean /@ Partition[peaks[[All, 1]], 2, 1]];
ListLinePlot[yvals - background,
DataRange -> MinMax@xvals,
Epilog -> {Red, PointSize[Large], Point@peaks, Blue,
Point[{#, interp@#} & /@ midpoints]},
PlotRange -> All]


peakAreas =
Integrate[interp[x], {x, #1, #2}] & @@@ Partition[midpoints, 2, 1]
(* {2.17032, 18.192, 12.8656, 11.233, 10.8508, 10.5048, \
10.2787, 10.2621, 10.4438, 9.58863, 9.48917, 9.15292, 9.03857, \
8.9062, 8.74465, 8.51919} *)

• Very nice! But unfortunately the shape of peaks could be very different. Moreover it could be several maximums inside one peak. The only definite thing is that there is linear region after each peak. – Филипп Цветков Aug 10 '16 at 21:21
• Like I said, I was just trying to get you started. Perhaps you could try to do the rest? – Jason B. Aug 10 '16 at 21:26
• Yes thank you. I will try – Филипп Цветков Aug 10 '16 at 21:28