Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

edit: Excellent answers have been provided and I made an animation which is suitable for my use, however, all the examples rely on bitmap/rasterized data; is there a vector based approach?

I would like to animate the formation of a voronoi network from a set of semi-random points.

points = Table[{i, j} + RandomReal[0.4, 2], {i, 10}, {j, 10}];
points = Flatten[points, 1];

The final VoronoiDiagram can be easily plotted with DiagramPlot in the ComputationalGeometry package.

Needs["ComputationalGeometry`"]
voronoi = DiagramPlot[points, TrimPoints -> 50, LabelPoints -> False];

I want to animate a series of circles growing outwards uniformly from each of the points until they intersect to form the voronoi network.

ExpandingCircles[r_, points_] := 
 Graphics@{Point /@ points, Circle[#, r] & /@ points}
plots = ExpandingCircles[#, points] & /@ {0.1, 0.2, 0.3, 0.4, 0.5};
GraphicsGrid@Partition[Join[plots, {voronoi}], 3]

Mathematica graphics

Similar to that progression but in mine the circles overlap. I want them to stop growing as they hit the adjacent circle to form the voronoi network but I can't figure out how to do this.

Based on @R.M.s pointing out @belisarius answer I've tried this:

GraphicsGrid@
 Partition[
  ColorNegate@
     EdgeDetect@
      Dilation[ColorNegate@Binarize@Rasterize@Graphics@Point@points, 
       DiskMatrix[#]] & /@ Range[1, 24, 3], 4] 

Mathematica graphics

However, I can't get them to merge into the voronoi structure.

Somewhat like this video (http://www.youtube.com/watch?v=FlkrBSh4514) except all of mine start growing at the same point in time.

share|improve this question
5  
There is this very nice answer by belisarius that answers your question. Since he's also active here, I'll wait for him to post that answer here, but do utilize that in the mean time for your work. –  rm -rf Apr 5 '12 at 19:52
    
@R.M That answer of mine was for a more difficult requirement, because the OP there wanted a final result looking like a "natural" tissue. I think the current answers are ok for this question –  belisarius Apr 6 '12 at 1:06
    
Re the edit: There is a natural vector-based approach. It relies on the fact that each Voronoi cell "belongs" to a specific point. (This is not the case for higher-order Voronoi diagrams.) Therefore, intersecting the disk of radius $r$ around each point $i$ with that point's Voronoi cell produces the desired collection of (non-overlapping) polygons at stage $r$ in the animation. Mathematica is not well suited to computing and displaying intersections of disks and polygons. –  whuber Apr 6 '12 at 16:05
add comment

2 Answers

up vote 26 down vote accepted

The first step is to rasterize the points, so let's just start there as an example:

n = 512;
g = Image[Map[Boole[# > 0.001] &, RandomReal[{0, 1}, {n, n}], {2}]]

The trick is to exploit the distance image. Almost all the work is done here (and it's fast):

i = DistanceTransform[g] // ImageAdjust // ImageData;

We need a little more precomputation of the final boundaries. Rasterizing a vector-based Voronoi tessellation would be faster, but here's a quick and dirty solution:

mask = Image[WatershedComponents[Image[i]]]

Now the animation is instantaneous: it's done simply by thresholding the distances. (Colorize it if you like.) Have fun!

Manipulate[
 ImageMultiply[
  Image[MorphologicalComponents[Image[Map[1 - Min[c, #] &, i, {2}]], 1 - c]], mask],
 {c, 0, 1}
 ]

enter image description here

share|improve this answer
    
Wonderful approach! And how would you add colors to that? I was thinking of using your result as a mask on a colorized Voronoi diagram, would that work? –  F'x Apr 5 '12 at 21:56
    
I haven't tested it--and am out of time today--but I imagine another application of MorphologicalComponents followed by Colorize would do it. –  whuber Apr 5 '12 at 21:58
    
Ah--it's not quite that simple, because the colors determined by Colorize change from frame to frame. Instead, consider colorizing the components of the "mask" itself, and then masking that with the thresholded distances. This will keep the colors constant. Not only that, it will be even faster because each frame requires only a threshold and multiply, nothing more. –  whuber Apr 5 '12 at 22:05
add comment

enter image description here

I know think of at least one way of doing it slowly and in a bitmap approach:

img[p_, r_] := Module[{f, closest, color, colors, n, t},
  n = 250;
  colors = 
   List @@@ {Red, Green, Blue, Yellow, Orange, Pink, 
     RGBColor[0, 0, 0], Cyan, Magenta, Brown, Purple};
  color[i_] := Module[{c},
    c = colors[[1 + Mod[i, Length@colors]]];
    If[i == 0, {1, 1, 1}, c]
    ];
  closest[pt_] := First@Ordering[Norm[pt - #] & /@ p, 1];
  Image[Table[Module[{res, pt},
     pt = {(i + 0.5)/n, (j + 0.5)/n};
     res = closest[pt];
     color[If[Norm[pt - p[[res]]] < r, res, 0]]
     ], {i, 1, n}, {j, 1, n}]]
  ]

which is then used as:

points = RandomReal[1, {25, 2}];
t = Table[img[points, r], {r, 0.03, 0.4, 0.03}];
Export["growth.gif", t];

What it does is for each point of the graph, determine both what's the closest point in the points set, and whether it's close enough to actually be inside it growth radius. Animate that on a fixed set of points with an increasing radius, and I believe you're there.

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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