CODEWITHSUNDEEP
windowswolfram-mathematicadropwolframalphawolfram-language
Hinata Shoyo
Hinata Shoyo

Reputation: 25

How to make a program in mathematica that gives us the radius of a drop from the theoretical profile of that drop?

How to make a program in Mathematica that is able to recognize this image and return the radius of the circular part of it? enter image description here

Upvotes: 0

Views: 105

Answers (1)

Chris Degnen
Chris Degnen

Reputation: 8655

While curve extraction is possible the radius can be obtained quite simply, i.e.

img = Import["https://i.sstatic.net/LENuK.jpg"];
{wd, ht} = ImageDimensions[img];
data = ImageData[img];
p1 = LengthWhile[data[[-33]], # == {1., 1., 1.} &];
p2 = LengthWhile[Reverse[data[[-33]]], # == {1., 1., 1.} &];
p120 = wd - p1 - p2 - 1;
p3 = LengthWhile[data[[-245]], # == {1., 1., 1.} &];
p4 = LengthWhile[Reverse[data[[-245]]], # == {1., 1., 1.} &];
pdrop = wd - p3 - p4 - 1;
radius = 120/p120*pdrop/2.

55.814

Further automation could automatically detect the widest point of the drop, which is here found by testing: line 245 (see sample lines in bottom image).

Making sense of the scale could be difficult to automate. We can see the outermost ticks are at -60 & 60, a length of 120 which turns out to be 400 pixels, pdrop.

As the sketch below shows, the circular part of the drop is limited by the widest points, so that length and the scale are all that is needed to find the radius.

enter image description here

Two lines are used to find the image scale and outer bounds of the drop: line 33 and 245, shown below coloured red.

enter image description here

Additional code

In the code below r is calibrated against the scale so that it equals 60.

img = Import["https://i.sstatic.net/LENuK.jpg"];
{wd, ht} = ImageDimensions[img];

Manipulate[
 Graphics[{Rectangle[{0, 0}, {wd, ht}],
   Inset[img, {0, 0}, {0, 0}, {wd, ht}],
   Inset[Graphics[{Circle[{x, y}, r]},
     ImageSize -> {wd, ht}, PlotRange -> {{0, wd}, {0, ht}}],
    {0, 0}, {0, 0}, {wd, ht}],
   Inset[
    Style["r = " <> ToString[Round[60 r/212.8, 0.1]], 16],
    {50, 510}]},
  ImageSize -> {wd, ht}, PlotRange -> {{0, wd}, {0, ht}}],
 {{x, 228}, 0, 300}, {{y, 247}, 0, 300}, {{r, 196}, 0, 300}]

enter image description here

Upvotes: 1

Related Questions