How to determine the distance between streaks in an image?

Questions
1

In this image (http://postimg.org/image/mu8uhwhhx/) there are 3 more or less vertical peaks in total. Let the x-axis be the horicontal 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 sorrounding peaks for every given y-value. So that I know the distance of these peak-centers as a function of y.
Within my code the 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 I need 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 intervall [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?

2

Dear Carol,

though your approach is OK, the syntax is not completely correct:

pb[column] = ...

will not an element of the array pb at some position column. One has to use pb[[column]] for that, but you have to create the array before.

In general, for loops are not used in Mathematica, there are more ‘nicer’ solutions. I wrote some code that should work:

ClearAll[FindMax]
FindMax[lst_List, range : {a_, b_}] := With[{l = Take[lst, range]}, -1 + a + First[FirstPosition[l, Max[l]]]]
img2 = Import["filepath\\testlong.jpg"];
data = ImageData[img2];
data = Map[Mean, data, {2}]\[Transpose];
middle = FindMax[#, {1, -1}] & /@ data
top = FindMax[#, {1, 60}] & /@ data
bottom = FindMax[#, {240, 280}] & /@ data
ListPlot[{middle, top, bottom}]

Please let me know if this works!

3

Thank you for your reply. Your code produces the error message

 "Mean::rectt: "Rectangular array expected at position 1 in Mean[0.03137254901960784`]""
4

The image you posted was in RGB, so I did the mean to create a black-white image. Remove the

data = Map[Mean, data, {2}]\[Transpose];

line in the code. Should work.

5

Now I get the error message "Take::take: Cannot take positions 240 through 280 in " and the plot is empty.

But the problem could be solved:

img2 = Import["file"];
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}]

Thank you for your help and the time you invested in my problem!

6

Hi,
Here is another approach. First convert the image to grayscale, then calculate the total of the columns and find the 3 largest peaks, using the build-in function FindPeaks. At the end showing the results together with the image.

findMax[values_, n_] := Module[{peaks},
  peaks = FindPeaks[values];
  SortBy[peaks, Last][[-n ;;]]
  ]
grayData = ImageData@ColorConvert[img1, "Grayscale"];
colTotals = Map[Total, Transpose[grayData]];
max3 = findMax[colTotals, 3];
GraphicsColumn[{ListDensityPlot[grayData, 
   Epilog -> { Gray, PointSize[0.02], 
     Point[{#, 155}] & /@ max3[[All, 1]]}], 
  ListLinePlot[colTotals, 
   Epilog -> { Red, PointSize[0.02], Point /@ max3}]}]