Message Boards

WOLFRAM COMMUNITY

4962 Views

5 Replies

5 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Image Processing

How to determine the distance between streaks in an image?

Carol Moalin

Posted 10 years ago

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?

POSTED BY: Carol Moalin

5 Replies

Sort By:

Sander Huisman

Sander Huisman, University of Twente

Posted 10 years ago

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!

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!

POSTED BY: Sander Huisman

Carol Moalin

Posted 10 years ago

Thank you for your reply. Your code produces the error message "Mean::rectt: "Rectangular array expected at position 1 in Mean[0.03137254901960784`]""

POSTED BY: Carol Moalin

Sander Huisman

Sander Huisman, University of Twente

Posted 10 years ago

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.

POSTED BY: Sander Huisman

Carol Moalin

Posted 10 years ago

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!

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!

POSTED BY: Carol Moalin

Michael Jensen

Posted 10 years ago

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}]}]

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}]}]

POSTED BY: Michael Jensen

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback