# How to split the droplets from a fiber?

As you see,I want to extract the droplets from a fiber,I have tried a fundamental but complex method,and I got the edge of the droplets,but I don't think it is a good way,I want to get all information of the droplets.

• I would appreciate any help in dealing with this image,mant thanks! – Quere Aug 24 '17 at 1:30
• What method have you tried? Can you show the code you used? Is that what you used to generate the colored outline you showed? – MarcoB Aug 24 '17 at 3:15
• You can remove the bright areas in the center of the drop using opening, e.g. Opening[img, DiskMatrix[10]] - then you have a dark object in front of a bright background, and the problem gets trivial. – Niki Estner Aug 24 '17 at 5:41
• Thanks for your attention!I put my code below.@MarcoB – Quere Aug 24 '17 at 7:16
• @Quere.... Er..... David Quere? – dearN Aug 24 '17 at 10:39

(。・ω´・)

HighlightImage[#,ColorNegate@DeleteSmallComponents@Erosion[Dilation[Binarize@#,3],3]]&@img


• six six six!Thanks for your answer! I am sorry to pardon you again,my question is how to deal with the binary image I post above.Because I have many images like this,and I couldn't ensure there always exist white section in the fiber.@jiaoeyushushu – Quere Aug 24 '17 at 8:52
• @Quere HighlightImage[#,DeleteBorderComponents[ColorNegate@Erosion[Dilation[# ,6],6]]]&@Binarizeimage – jiaoeyushushu Aug 24 '17 at 10:36
• Thanks! I have learned a lot.@jiaoeyushushu – Quere Aug 24 '17 at 11:00
• It seems doesn't work! How amazing!@jiaoeyushushu – Quere Aug 24 '17 at 13:38

For convenience,I put my code there.I am sorry that my code is hard to read because I am not familiar with Mahthematica.Simple to say,my idea is considering the width of the fiber by lines,If the width changes a lot quickly,there may exist a droplet.

Clear["Global*"];
(*import the picture*)
image = Import["C:/Users/USER/Desktop/s.png"];
image2 = ColorConvert[image, "Grayscale"];
coordinate = ImageValuePositions[image2, 0, 0.75];
ListPlot[coordinate, PlotStyle -> Black, AspectRatio -> 549/60,
Axes -> False];
Binarize[image, 0.75];
part = Split[coordinate, #2[[2]] == #1[[2]] &];
partlength = Length@part;
data = {};
Do[
xmin = Min@Table[part[[i, j]][[1]], {j, 1, Length@part[[i]]}];
yforxmin = Select[part[[i]], #[[1]] == xmin &][[1, 2]];
xmax = Max@Table[part[[i, j]][[1]], {j, 1, Length@part[[i]]}];
yforxmax = Select[part[[i]], #[[1]] == xmax &][[1, 2]];
AppendTo[data, {xmin, yforxmin}];
AppendTo[data, {xmax, yforxmax}],
{i, 1, partlength}];
n = Length@data/2;
sma = {data[[1]], data[[2]]}; lar = {};
note = 1;
yes = 1; no = 0;
key = Abs[data[[1, 1]] - (data[[2, 1]] - data[[1, 1]])/2];
Do[
keyi = Abs[
data[[2 i + 1, 1]] - (data[[2 i + 2, 1]] - data[[2 i + 1, 1]])/2];
If[key - 3 < keyi < key + 3,
yes = yes + 1;
If[yes == 1,
AppendTo[lar, sma]; sma = {}; no = 0,
AppendTo[sma, data[[2 i + 1]]]; AppendTo[sma, data[[2 i + 2]]];
note = note + 1; If[Mod[note, 30] == 0, key = keyi]],
no = no + 1;
If[no == 1,
AppendTo[lar, sma]; sma = {}; yes = 0,
AppendTo[sma, data[[2 i + 1]]];
AppendTo[sma, data[[2 i + 2]]]]],
{i, 1, n - 1}];
larlength = Length@lar;
ListPlot[Table[lar[[i]], {i, 1, larlength}], AspectRatio -> 549/60,
PlotStyle -> {{Red, PointSize[0.02]}, {Blue,
PointSize[0.02]}, {Green, PointSize[0.02]}, {Black,
PointSize[0.02]}}, Axes -> False]


The result is,

% // Show[image, #] &


we get