16
$\begingroup$

So I recently read this excellent post about generating random points over arbitrary regions. I hope Wolfram eventually builds that functionality into Mathematica's Random functions. I want to do this for binary images.

Given a binary image like this:

Map of the UK

... I can generate random lattice points over the black parts by doing:

 ListPlot[RandomSample[PixelValuePositions[Binarize[img], Black],1500],
  AspectRatio -> ImageAspectRatio[img]]

which gives this plot:

Random lattice points

However, the problem is that all generated random points will lie on integer coordinates. For example, the point {150, 100} can be generated by my approach, yet the point {150.278, 100.123} will never be generated. I want to generate random points uniformly anywhere within the coastlines/black regions.

$\endgroup$
  • 2
    $\begingroup$ Since the linked answer already provides a number of methods to generate points within a Region I believe this question would be answered by a way to convert your binary mask into a Region; is that correct? $\endgroup$ – Mr.Wizard May 14 '15 at 10:38
  • 2
    $\begingroup$ You can think of a pixel as a randomly selected square "cell", then you can add a RandomReal[{-1, 1}, 2] on it. $\endgroup$ – Silvia May 14 '15 at 12:37
  • 1
    $\begingroup$ @Silvia Let me see if I understand: Generate positions for all black pixels; randomly pick one, then generate a RandomReal pair within that "cell"; do this as many times as points are needed. Are you going to write that up as an answer? $\endgroup$ – Mr.Wizard May 14 '15 at 12:47
  • 1
    $\begingroup$ @Silvia It's posted (and now Accepted) below. Thanks for the brilliant idea! I owe you a Bounty; let me know where you would like it applied. (Either for an answer of your own or to draw attention to a question that matters to you.) $\endgroup$ – Mr.Wizard May 14 '15 at 14:06
  • 1
    $\begingroup$ @Silvia Bounty started. $\endgroup$ – Mr.Wizard May 14 '15 at 14:29
17
$\begingroup$

Update

Silvia proposed a much faster algorithm that I believe produces I uniform distribution.
Here is my implementation of it.

pointsInMask2[mask_Image, n_Integer, range : {_, _} : {0, 1/2}] :=
  Reverse @ ImageData @ Binarize[mask, range]\[Transpose] //
    SparseArray[#]["NonzeroPositions"] & //
      RandomChoice[#, n] + RandomReal[{-1, 0}, {n, 2}] &

img = Import["http://i.stack.imgur.com/yoPNX.png"];

Graphics[{
  AbsolutePointSize[1], Opacity[0.3],
  pointsInMask2[img, 75000] // Point
}]

enter image description here

The optional range parameter specifies the range of values in the mask image that are valid target area.

Graphics[{
  AbsolutePointSize[1], Opacity[0.3],
  pointsInMask2[img, 75000, {1/2, 1}] // Point
}]

enter image description here


A "brute force" method

Although my first method will be superior if one wishes to generate many points there is a more direct and simple approach, though it does not benefit from any of the optimizations in the linked question. That is simply to generate random points and select the ones for which the matching ImageValue is closer to black than white. This requires redundant sampling and will be increasingly slow on images with a small percentage of black pixels. (For now I am simply estimating the number of samples needed and not performing a check to make sure the requested number are actually produced; if this method proves useful I shall refine my approach.)

pointsInMask[mask_Image, n_Integer] :=
  Module[{dims, pts, n2},
    dims = ImageDimensions[mask];
    n2 = ⌈ 1.1 n #/(# - ImageData[mask] ~Total~ 2) &[Times @@ dims] ⌉;
    pts = RandomReal[#, n2] & /@ dims // Transpose;
    Select[pts, ImageValue[mask, #] < 0.5 &, n]
  ]

Test:

mask = Binarize @ Import["http://i.stack.imgur.com/yoPNX.png"]

pts = pointsInMask[mask, 5000];

Graphics[{AbsolutePointSize[1], Point @ pts}]

enter image description here

$\endgroup$
  • 2
    $\begingroup$ I think this is the best approach, take the random lattice points and then fuzz them in a random direction. But this new method doesn't produce a uniform distribution. There are strange diagonal runs imgur.com/uUfyxYw if you look closely. I think you're meant to add + RandomReal[{-1/2, 1/2}, {n, 2}] or possibly RandomReal[{-1,1},{n,2}] not RandomReal[{-1, 0}, n]. $\endgroup$ – Histograms May 14 '15 at 13:52
  • $\begingroup$ @Histograms Ah, right, that was stupid! $\endgroup$ – Mr.Wizard May 14 '15 at 13:57
  • 1
    $\begingroup$ @Histograms I used {-1, 0} because I wanted the space to start from {0, 0} rather than {1, 1} to follow the scheme of ImageValue. $\endgroup$ – Mr.Wizard May 14 '15 at 14:00
  • 3
    $\begingroup$ Probably unimportant given the update, but Nearest can be used to speed up the brute force method: E.g., fyi, data = ImageData[mask, DataReversed -> True]; nf = Nearest[Tuples[Range /@ dims] -> Flatten[Transpose@data, 1]]; pts = RandomReal[#, n2] & /@ dims // Transpose; Take[Pick[pts, Flatten@nf[pts], 0], n]. $\endgroup$ – Michael E2 May 14 '15 at 14:11
12
$\begingroup$

Following up on my comment and borrowing a method from Vectorizing an image like "Trace Bitmap" in Inkscape:

mask = Binarize @ Import["http://i.stack.imgur.com/yoPNX.png"];

{row, col} = ImageDimensions[mask];

intf = ListInterpolation @ Reverse @ ImageData @ mask;

region = DiscretizeGraphics @ 
  RegionPlot[intf[c, r] < 1/2, {r, 1, row}, {c, 1, col},
    PlotPoints -> {row, col}, MaxRecursion -> 0]

enter image description here

You can then apply whichever of the methods from How to generate random points in a region? that you find appropriate, e.g.:

pts = randomFromRegion[region, 15000];

Graphics[{AbsolutePointSize[1], Point @ pts}]

enter image description here

$\endgroup$
  • $\begingroup$ This result is exactly what I want. However, the line with region = DiscretizeGraphics... is painfully slow. I was hoping there would be a way to turn the binary image into a sparser triangulation on the interior (with a more refined mesh near the coastlines) as that would be faster to operate on (by using the DirichletDistribution approach). $\endgroup$ – Histograms May 14 '15 at 12:07
  • $\begingroup$ @Histograms I added a second answer. Rather than a lengthy region generation but very fast point generation it goes the other direction; a few points are very fast to generate but making many will be slow. $\endgroup$ – Mr.Wizard May 14 '15 at 12:28
6
$\begingroup$

In version 11, one can use ImageMesh[] in tandem with RandomPoint[], like so:

imsh = ImageMesh[ColorNegate[Import["http://i.stack.imgur.com/yoPNX.png"]]];
Graphics[Point[RandomPoint[imsh, 5000]]]

random points from binary image

$\endgroup$

Your Answer

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

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