I was wondering if there was a neat way to solve the following problem in Mathematica v9 -

Provided a binarized image (where we call black pixels "obstacles" or vice versa, whichever is most convenient), is there a way to automatically generate a closed-curve with a fixed perimeter length and target amount of enclosed area (or vice versa, a fixed enclosed area and a target perimeter length) that avoids obstacles as well as the edges of the image?

For a fun example image, perhaps the automatically generated inkblot enter image description here from J.M.'s answer to How to make an inkblot?, calling black pixels obstacles in this case?

I don't have any fantastic ideas for how to do this, and as such my efforts thus far consist mostly of placing a random polytope on the surface of the image, and making sure that no points come within a distance 'd' of the polytope's edges. We first import and process the image as follows:

img = Import["http://i.stack.imgur.com/19SQ6.png"];
img = Binarize[ColorSeparate[img][[1]]]

We can then define a polygon, poli, and use the distance function from this Wolfram demonstration http://demonstrations.wolfram.com/DistanceOfAPointToAPolygon/ to check that the distance from the center of every dark pixel to the polygon is at least some threshold amount.

Here's the distance function:

dis[{a_, b_}, p_] := Module[{pz, az, bz, z},
If[a == b, {a, Norm[p - a]},
 {pz, az, bz} = Map[First[#] + I Last[#] &, {p, a, b}];
  z = (pz - az)/(bz - az);
If[Not[0 <= Re[z] <= 1], d1 = Norm[p - a]; d2 = Norm[p - b]; 
 If[d1 < d2, {a, d1}, {b, d2}],
  {a + Re[z] (b - a), Norm[Im[z] (b - a)]}]]];

An example of its usage would be the following:

p = {1, 1};
poli = {{0, 0}, {5, 6}, {1, -1}};

f = Map[dis[#, p] &, Partition[poli, 2, 1, 1]];
{c, d} = First[Sort[f, Last[#1] <= Last[#2] &]];

Where 'd' is the minimum distance from 'p' to 'poli'.

This approach is inelegant, to say the least, and I'm having a difficult time coming up with a good procedure to randomly generate polygons with perimeter/area constraints, or to determine the most efficient way to sweep the polygon across the image.

  • 1
    $\begingroup$ Any code you are working on ? $\endgroup$ – Sektor Aug 29 '13 at 20:36
  • $\begingroup$ @NikolaDimitrov Nothing special, however I have updated my question with a brief discussion of something I have tried. $\endgroup$ – TilePath Aug 29 '13 at 21:58
  • 1
    $\begingroup$ I think you should divide your question int two parts: (1) designing the algorithm, and (2) implementing it in Mathematica. You will get a lot of help on (2) in this forum. Regarding (1) … you would have better outcome asking in a different forum. $\endgroup$ – Hector Aug 31 '13 at 1:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.