Skip to main content

list manipulation - Estimating the full width half maximum of a peak



I have a dataset of which I'm attempting to determine the full width at half maximum. A picture of the data is given below, and the dataset itself can be found here (pastebin). enter image description here


Now, this set has a minimum, which can be found rather easily. Say we call the data yy, then by using Min[yy] we've found the minimum. To find the full width half max, it is then probably easiest to look for a point closest to 1-(1-Min[yy])*0.5 in yy. The first thing that came to mind was using Nearest[yy,1-(1-Min[yy])*0.5,1] which indeed returns a value of yyclosest to half of the FWHM. But I'm having some trouble finding the actual position of this point in the data. Ironically, using Position[yy,Nearest[yy,1-(1-Min[yy])*0.5,1]] seems to come up empty. I'm not sure why exactly this is, but maybe there is some rounding going on, or incompatible outputs. I've tried thinking of a solution to this, but it doesn't seem obvious to me.


My question is therefore if anyone seems a workaround, or an all around better idea. My plan was to find this position of the half-max point, find the corresponding xx, subtract the xx element of the position of the max, and multiply by two. I don't need a 100% perfect estimation; this should be good enough.



Answer



Here is an approach. You could also search around the midpoint. In the following data was imported using ImportString from pastebin link.


A non-linear model was developed. The starting points were 'guessed' with the assistance of manipulate.


nlm = NonlinearModelFit[N@ToExpression[data], 
  d - c/(1 + a (x - b)^2), {{a, 150000.}, {b, 7.62}, {c, 0.064}, {d, 
    1.}}, x]
Show[Plot[nlm[x], {x, 7.6, 7.65}, PlotRange -> {0.90, 1}, 

  PlotStyle -> Red], 
 ListPlot[data, PlotMarkers -> {Style[\[FilledDiamond], Black], 5}]]

enter image description here The fit (visually is not unreasonable, adjusted $R^2$ 0.999989).


Now to determine width.


bf = nlm["BestFitParameters"]
ypeak = nlm[x] /. First@Quiet[Solve[D[nlm[x], x] == 0, x]];
hmw = ypeak + ((d /. bf) - ypeak)/2;
{xr, xl} = x /. NSolve[nlm[x] == hmw, x];
xr - xl

Show[Plot[nlm[x], {x, 7.6, 7.65}, PlotRange -> {0.90, 1}, 
  PlotStyle -> Red, 
  Epilog -> {Green, PointSize[0.02], Point[{#, nlm@#} & /@ {xl, xr}]},
   GridLines -> {{xl, xr}, {d /. bf, hmw, ypeak}}, 
  GridLinesStyle -> Directive[Gray, Dashed]], 
 ListPlot[data, PlotMarkers -> {Style[\[FilledDiamond], Black], 5}]]

The x values: {7.61527, 7.61774}. The width: 0.00247168.


enter image description here


This can adpated, improved and I look forward to better answers.



Comments

Post a Comment

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...
Post a Comment
Read more

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...
Post a Comment
Read more

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...
Post a Comment
Read more