# Fitting of peaks with constraint condition of same area

If I have the following data:

https://pastebin.com/RFVd0MpU

Which plotted between 60 to 100 (celsius) using the following code, gives:

ListLinePlot[datawithnoliquidline,
PlotStyle -> Directive[Thick, Black],
PlotRange -> {{60, 110}, {-0.5, All}}, Frame -> True,
FrameStyle -> 14, Axes -> False, GridLines -> Automatic,
GridLinesStyle -> Lighter[Gray, .8],
FrameTicks -> {Automatic, Automatic},
FrameLabel -> (Style[#, 20, Bold] & /@ {"T (\[Degree]C)",
Row[{"\!$$\*SubscriptBox[\(C$$, $$P$$]\)", " (", " J/gK)"}]}),
LabelStyle -> {Black, Bold, 14}]


Questions:

1. How can I fit the two peaks in the opposite directions (see image below) knowing that both peaks have the same area?
2. How can I find the area of both peaks?.

Note the baseline for both peaks is at zero.

This is my approach so far. As you can see I am close but I am hoping someone here can help me improve what is missing:

ma5guess = 5;
siga5guess = 8;
ma3guess = 1.3;
siga3guess = 3;
meda3guess = 97;
meda5guess = 75;

ff2[x_, areaa3_, areaa5_, siga3_, meda3_, meda5_, siga5_] :=
areaa3 PDF[NormalDistribution[meda3, siga3], x] -
areaa5 PDF[SkewNormalDistribution[meda5, siga5, -5], x] ;

nlm3 = NonlinearModelFit[
datawithnoliquidline, {ff2[x, areaa3, areaa5, siga3, meda3, meda5,
siga5], areaa3 >=  0, meda3 - 2*siga3 > 80,
68 < meda5 - 2*siga5 < meda3 - 2*siga3}, {{areaa3,
ma3guess}, {areaa5, ma5guess}, {siga3, siga3guess}, {meda3,
meda3guess}, {meda5, meda5guess}, {siga5, siga5guess}}, x];

fp = nlm3["BestFitParameters"];

p1 =(*Original data*)
ListLinePlot[datawithnoliquidline,
PlotStyle -> Directive[Thick, Black],
PlotRange -> {{40, 110}, {-0.5, All}}, Frame -> True,
FrameStyle -> 14, Axes -> False, GridLines -> Automatic,
GridLinesStyle -> Lighter[Gray, .8],
FrameTicks -> {Automatic, Automatic},
FrameLabel -> (Style[#, 20, Bold] & /@ {"T (\[Degree]C)",
Row[{"\!$$\*SubscriptBox[\(C$$, $$P$$]\)", " (", " J/gK)"}]}),
LabelStyle -> {Black, Bold, 14}];

p2b = Plot[{nlm3[x],
areaa3 PDF[NormalDistribution[meda3, siga3], x] /.
fp, -areaa5 PDF[SkewNormalDistribution[meda5, siga5, -5], x] /.
fp}, {x, 40, 110},
PlotStyle -> {Directive[Red, Dashing[{0.02, 0.04}],
AbsoluteThickness[5]], Directive[Green, AbsoluteThickness[2]],
Directive[Orange, AbsoluteThickness[2]]}, PlotRange -> All];

Show[p1, p2b]


Which gives:

• I believe your problem is ill-posed. If you could prescribe the shape of the peak (for instance a Gaussian curve) and the two ranges where you want to fit them, then you could minimize a cost without two much difficulty. Oct 24, 2020 at 12:26

Here is a fit to the data:

f[x_] = p1 Exp[-(x - p2)^2 p3] + p4 Exp[-(x - p5)^2 p6] /.
FindFit[dat1,
p1 Exp[-(x - p2)^2 p3] + p4 Exp[-(x - p5)^2 p6], {p1, {p2, 75}, p3,
p4, {p5, 90}, p6}, x]
Plot[f[x], {x, dat1[[1, 1]], dat1[[-1, 1]]},
Epilog -> {PointSize[0.001], Point[dat1]}]


The areas you can get from:

{f1[x_], f2[x_]} = {p1 Exp[-(x - p2)^2 p3],
p4 Exp[-(x - p5)^2 p6]} /.
FindFit[dat1,
p1 Exp[-(x - p2)^2 p3] + p4 Exp[-(x - p5)^2 p6], {p1, {p2, 75},
p3, p4, {p5, 90}, p6}, x];
Integrate[{f1[x], f2[x]}, {x, 60, 110}]
(*{-1.35076, 1.02609}*)


However, note that the your assumptions of "the baseline for both peaks is at zero" is obviously not right.

• Daniel, thank you very much for your answer. However, when I put your code as it is and change the name of the data to "dat1" and get "FindFit::cvmit: Failed to converge to the requested accuracy or precision within 100 iterations.". Also the peak 1 seems to be cut and it is unclear the fit for that peak. Did you cut the data or use it as it was in the post?
– John
Oct 23, 2020 at 17:16
• Hi John,I did only use data from approx. 70 to 115 degree. I tried to reproduce it. I copied/pasted your data: dat0={{...},{...},...} Then I take a part: dat1 = dat0[[2400 ;; 3800]]; Then the result from the fit is: {p1 -> -0.107358, p2 -> 75.6448, p3 -> 0.0198087, p4 -> 0.170771, p5 -> 89.1813, p6 -> 0.0870177} Oct 23, 2020 at 18:19
• Try subtracting a base line to make the base more constant, then the fit should be easier. Oct 23, 2020 at 18:43
• Hi John, I do not think this is correct. You are fitting two functions with baselines of zero to some data that has a very curved baseline. To judge the fit you need to plot the error. And the error will be bad because your data has a very konvex baseline, you can not simply ignore this. The thing to do is to first subtract the baseline, then do the fit and then add the baseline again. Another approach is to use fit-functions that do not assume a baseline of zero. Note, the word convolution has another meaning than you think, look it up. I think you mean overlay. Oct 23, 2020 at 19:19
• That's "handwork". You could use e.g. some spline (read about it in the help, there are several different variety ). They have "control points," with which you can form a smooth curve of arbitrary shape. This can be done in e.g. a LocatorPane or in a Manipulate, but this will need some coding. When you have the curve, you calculate its value at the data points and subtract it. It would be easier if you know what determines the baseline, but in practice, this is often not the case. Oct 23, 2020 at 19:56

Here is an example that you can adapt to your data for fitting a spline to given points. This example fits a curve to points from a Morse potential. You can move the locator to adapt the function:

pts = {{0, 10}, {1, 5}, {2, 2}, {3, 1}, {4, 2}, {5, 4}, {6, 5}, {7, 5.5}, {8, 6}};(*data points. Do not use too many data points, otherwise you will slow down the graphics*)
loc = {{1, 4}, {2, 1}, {4, 1}, {6, 3}, {7, 4}};(*locators*)
DynamicModule[{},
Dynamic@Show[
Graphics[{Locator[Dynamic[loc[[1]]]], Locator[Dynamic[loc[[2]]]],
Locator[Dynamic[loc[[3]]]], Locator[Dynamic[loc[[4]]]],
Locator[Dynamic[loc[[5]]]],
spline =
BezierCurve[Join[{pts[[1]]}, loc, {pts[[-1]]}],
SplineDegree -> (Length@loc + 1)], {PointSize[0.02], Red,
Point[pts]}}, Axes -> True, PlotRange -> {{-2, 10}, {-5, 12}}],
ParametricPlot[spline[x], {x, 0, 10}]
]]


If you finally got the points in "loc" you can make a function that you can use to subtract the baseline:

bf = BezierFunction[Join[{pts[[1]]}, loc, {pts[[-1]]}]];
fun = Interpolation[Table[bf[t], {t, 0, 1, 0.05}]];
Plot[fun[x], {x, pts[[1, 1]], pts[[-1, 1]]}]