5
$\begingroup$

I have the following image:

enter image description here

In this image there are 5 more or less vertical peaks in total. Let the x-axis be the horizontal axis and y-axis be the vertical axis. I would like to determine the distance between the center of the most intense peak (peak in the middle of the image) and the centers of the 4 symmetrically surrounding peaks for every given y-value. So that I know the distance of these peak-centers as a function of y.

For reasons of testing the code, I have selected a smaller area in the original image file:

testlong

Within my code this image is called: testlong.jpg

My code so far:

img2 = Import["filepath\\testlong.jpg"];
data2 = ImageData[img2];
Dimensions[data2]

For[column = 1, column < 83, column++, pc[column] =        
Position[data2[[All,  column]], Max[data2[[All, column]]]];
pb[column] = Position[data2[[1 ;; 60, column]], Max[data2[[1 ;; 60, 
column]]]];
pt[column] = 239 + Position[data2[[240 ;; 282, column]], Max[data2[[240 
;; 280, column]]]];];

For[lauf = 1, lauf < 83, lauf++, pcflat[lauf] = Flatten[pc[lauf]]];
For[lauf = 1, lauf < 83, lauf++, pbflat[lauf] = Flatten[pb[lauf]]];
For[lauf = 1, lauf < 83, lauf++, ptflat[lauf] = Flatten[pt[lauf]]];

Now what's to do is to plot pcflat, ptflat, pbflat, fit each one with a line of best fit and determine the distance between these lines. But I don't seem to be able to plot pcflat, ptflat, pbflat. If I use:

ListPlot[Table[pcflat[i],{i,1,82}],PlotRange->All]

Mathematica plots 3 points within the interval [1,2]

The problem is, that pcflat, pbflat, etc are nested lists with unequal length, because some x-values correspond with more than one y-value where there is a maximum (peaks are not delta peaks but have a width). How do I plot that?

$\endgroup$
  • 1
    $\begingroup$ For takers: Ausgleichsgerade == line of best fit. $\endgroup$ – Yves Klett Oct 1 '15 at 19:42
8
$\begingroup$

Since you are looking for vertical lines, the problem is 1D. Start by summing the pixels for each column of the image:

img2 = Import["http://s4.postimg.org/dearql4iz/XZ_85.png"];
data2 = ImageData[img2];
sums = Map[Tr, Transpose@data2];
ListPlot[sums]

enter image description here

It seems the 5 five lines you are mentionning are not so clear. But we can see clearly three of them.

Using FindPeaks to find the positions of the lines, sorting them with respect to the second component and selecting the five first ones:

peaks = FindPeaks[sums];
selectedPeaks = Sort[peaks, #1[[2]] > #2[[2]] &][[1 ;; 5]] 
Show[ListPlot[sums, PlotRange -> Full], 
      ListPlot[selectedPeaks, PlotStyle -> Red]]

enter image description here

Show[img2, Graphics[{Red, Dashed, Map[Line[{{#, 0}, {#, h}}] &, selectedPeaks[[All, 1]] ]}]]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you for that great answer, in this code I do not even have to specify intervals around the peaks. $\endgroup$ – 11drsnuggles11 Oct 2 '15 at 18:29
3
$\begingroup$

There are some problems with the way you generate your data. The biggest one is that Position returns multiple locations because maximum pixel value happens more than once for one y-value. For example, from your code, if you look at pb[2], you'll get {{29}, {33}, {34}, {35}}. This means that the maximum value occurs four times in that column. The easiest way to fix this is to take the average of all the locations. Here's a working solution.

img2 = Import["C:\\Users\\labuser\\Downloads\\testlong.jpg"];
data2 = ImageData[img2];
Dimensions[data2];

For[column = 1, column < 83, column++, 
  pc[column] = 
   Mean[Flatten[
     Position[data2[[All, column]], Max[data2[[All, column]]]]]];
  pb[column] = 
   Mean[Flatten[
     Position[data2[[1 ;; 60, column]], 
      Max[data2[[1 ;; 60, column]]]]]];
  pt[column] = 
   Mean[Flatten[
     239 + Position[data2[[240 ;; 282, column]], 
       Max[data2[[240 ;; 280, column]]]]]]];
pbflat = Table[pb[i], {i, 1, 82}];
ptflat = Table[pt[i], {i, 1, 82}];
pcflat = Table[pc[i], {i, 1, 82}];
ListPlot[{pbflat, ptflat, pcflat}]

Working plot

After that, it's just a matter of fitting a line to each of the data set.

I haven't changed much of your code. There are things you could do that could make it much more efficient. For example, your code could be a lot faster by using Map/Scan/Apply instead of procedural programming, i.e. for loop. See this 10 tips for writing fast Mathematica code, item#9 for a comparison. Unfortunately, I can't post the link to this article because my reputation is not enough. (Tragedy). But a quick google of the article's name will turn it up.

$\endgroup$
  • $\begingroup$ Thank you for your answer, I especially like that you used my code and corrected it, that way it is easier for me to improve. Also thx for the literature tip. $\endgroup$ – 11drsnuggles11 Oct 2 '15 at 18:31

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.