Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I've got some image data that I've binarized. The image contains two curves, from which I'd like to compute the distance between (eventually computing an average radius for each point in the picture). I've done the computation, but it's done in C programmer style, and fairly ugly

data = ImageData[ b ] ;
{h, w} = Dimensions[data] ;

min = Table[0, {w}] ;
max = Table[0, {w}] ;
averageRadiusList = {} ;
scale = 0.1 / w  ;

For [ column = 1, column < w + 1, column++,
 For [ row = 1, row < h/2, row++,
   If [
    data[[row, column]] != 1,
       min[[column]] =  row ; Break
    ]
   ]
  For [ row = h, row > h/2, row--,
   If [
    data[[row, column]] != 1,
      max[[column]] =  row ; Break
    ]
   ]
  If [ min[[column]] !=  0  && max[[column]] != 0,

   AppendTo[
    averageRadiusList, {column * scale,
     scale * (max[[column]] - min[[column]])/2} ]
   ]
 ]

I was wondering if there's a more natural "Mathematica way" of doing things ... something that is presumably more elegant, efficient, compact, and more general?

share|improve this question
    
Did you check the [question]: mathematica.stackexchange.com/questions/1524 which explains some data obtained from a picture with nice mathematica functions. –  s.s.o Apr 18 '12 at 23:33
1  
Can use "fast marching" to move from one curve equidistantly outward, stopping when you hit the other. Code for this sort of thing can be found at blog.wolfram.com/data/uploads/2010/12/… That notebook is explained, to an extent, in the corresponding company blog from a while back. blog.wolfram.com/2010/12/07/navigating-the-blenheim-maze –  Daniel Lichtblau Apr 18 '12 at 23:34
    
Or can use Nearest on the first set of pixels to create a NearestFunction object. Then iterate over the second set using that NearestFunction, taking the closest in set 1 to each pixel in set 2. Finally take the pair that gives the min distance. –  Daniel Lichtblau Apr 18 '12 at 23:37
    
I was able to follow and replicate the steps up to producing the table of colour disks, but couldn't get the Image@Replace step to work for me. In that step there's more fancy syntax that I don't understand than I do. I guess what I'm really looking for is a way to extract just the locations of the 0 pixels without using a set of nested For[] loops. –  Peeter Joot Apr 19 '12 at 0:57
2  
@PeeterJoot Internal`Bag is an undocumented function. You can find some information plus links to other sources in this question –  Heike Apr 19 '12 at 9:38

1 Answer 1

up vote 6 down vote accepted

Lets start with an example image

img = Binarize@
  Image[Plot[{Sin[2 x], 2 + Cos[3 x]}, {x, 0, 2 Pi}, Axes -> False, 
    PlotStyle -> Black, Background -> White, ImagePadding -> None, 
    PlotRangePadding -> {None, .1}]]

example image

To find the distance between the two curves you could do something like

data = ImageData[img];
w = Dimensions[data][[2]];
scale = .1/w;

averageRadiusList = Reap[Sow @@@ Position[data, 0], Range[w],
    {scale #1, scale (Max[#2] - Min[#2])/2} &][[2, All, 1]];

ListPlot[averageRadiusList]

radius

What this code does is to find the indices of all black points in img. The combination of Sow and Reap will effectively group these coordinates by their column index and for each group return {scale c, scale (Max[rows]-Min[rows])/2} where c is the column index, and rows is a list of row indices of all black points in the plot that have column index c.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.