Date: Apr 26, 2013 4:24 AM Author: Bob Hanlon Subject: Re: Converting a magnified image of a line to a single

trace = Import["http://www.d-a-v-e.org/images/Trace.jpg"]

b = ColorNegate@Binarize[trace];

b2 = SelectComponents[b, "Area", -1];

b3 = FillingTransform@b2;

dt = ImageAdjust@DistanceTransform@b3;

resultOut = ImageValuePositions[Image[WatershedComponents[dt], "Bit"], 0];

bsf1 = BSplineFunction[MovingAverage[resultOut, 5]];

bsf2 = BSplineFunction[Mean /@ GatherBy[resultOut, First]];

Row[

ParametricPlot[#[x], {x, 0, 1}, ImageSize -> 200] & /@

{bsf1, bsf2}]

Bob Hanlon

On Thu, Apr 25, 2013 at 2:52 AM, Dave Waddell <dwwaddell@gmail.com> wrote:

> On 4/20/13 4:41 AM, Dave Waddell wrote:

> > I tried converting the result image to a graph so that I could apply a

> > moving average and then fit a B-spline through it. As you can tell I'm

> > new to Mathematica:

> > data = ArrayRules@SparseArray@ImageData[result]

> > It was all downhill after that. Another nudge would be appreciated.

> > Thanks, Dave.

> >

> > Dave,

> >

> > On 4/17/13 1:30 AM, Dave Waddell wrote:

> >> I have a magnified image of a 0.1mm line here:

> >> http://www.d-a-v-e.org/images/Trace.jpg

> >> ... this converts with Binarize very well:

> >> http://www.d-a-v-e.org/images/Trace%20binary.jpg

> >> ... but what I would like to do is convert it to a single pixel wide

> > smoothed line running right up the middle. Any suggestions or pointers

> > on how to do this in Mathematica would be appreciated.

> >> Dave

> >>

> >

> > The sequence below seems like a good start.

> > The documentation for the functions should help you understand what is

> > going on in more details:

> >

> > trace = Import["http://www.d-a-v-e.org/images/Trace.jpg"]

> >

> > b = ColorNegate@Binarize[trace];

> > b2 = SelectComponents[b, "Area", -1];

> > b3 = FillingTransform@b2;

> > dt = ImageAdjust@DistanceTransform@b3; result =

> > ColorNegate@Image[WatershedComponents[dt], "Bit"];

> > HighlightImage[trace, result]

> >

> >

> > Matthias Odisio

> > Wolfram Research

>

> ImageValuePositions will give you the coordinates of the white pixels:

>

> In[21]:= ImageValuePositions[Image[IdentityMatrix[3], "Bit"], 1]

>

> Out[21]= {{0.5, 2.5}, {1.5, 1.5}, {2.5, 0.5}}

>

> Please note that ImageValuePositions does not sort the returned positions

> in

> any specific order.

>

> Matthias

>

> So I think I'm really close:

> resultOut = ImageValuePositions[Image[WatershedComponents[dt], "Bit"], 0]

> BSplineFunction[MovingAverage[resultOut, 5]]

> ParametricPlot[%170[x], {x, -8, 8}]

>

> ... but I feel I could do much better and make it smoother. All suggestions

> are much appreciated.

> Dave

>

>

>