5
$\begingroup$

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?

$\endgroup$
10
  • $\begingroup$ Did you check the [question]: mathematica.stackexchange.com/questions/1524 which explains some data obtained from a picture with nice mathematica functions. $\endgroup$
    – s.s.o
    Apr 18, 2012 at 23:33
  • 1
    $\begingroup$ 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 $\endgroup$ Apr 18, 2012 at 23:34
  • $\begingroup$ 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. $\endgroup$ Apr 18, 2012 at 23:37
  • $\begingroup$ 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. $\endgroup$ Apr 19, 2012 at 0:57
  • 2
    $\begingroup$ @PeeterJoot Internal`Bag is an undocumented function. You can find some information plus links to other sources in this question $\endgroup$
    – Heike
    Apr 19, 2012 at 9:38

1 Answer 1

6
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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