-4
$\begingroup$

I would like to produce some 3D distributions of points using Mathematica 7.0, that look like the picture below :

A 3D fractal-like/percolation-like distribution of random points in 3D space

How could I do that ? What are your suggestions ? What Mma 7 codes could do a distribution of points which is approximately like this ? I'm not specifically looking for a diffusion limited aggregation method. Any other method would be interesting, if it's reasonably fast.

Ideally, the code should compile very fast.

Adding some color shades to the distribution would be a nice option.

EDIT : The picture above was taken from this topic : Distribution of random points in 3D space to simulate the Crab Nebula which is about filaments and sub-structures in the Crab nebula.

Improve this question
$\endgroup$
27
  • $\begingroup$ Since the image looks MMA-made, do you happen to have a reference or (even better) some code to show for it? $\endgroup$ Commented Feb 4, 2014 at 17:10
  • $\begingroup$ The picture was grabbed from another topic, that gives an answer to a similar question. But the code isn't compatible with Mma 7.0 and the results aren't the same at all (it was about filaments and random walks). I'm restarting my project from scratch. $\endgroup$ Commented Feb 4, 2014 at 17:15
  • 6
    $\begingroup$ You could have at least linked to where the picture came from, that is here. I did post the code to do the simulation in that very post. (!!) You can't expect people to just guess that this is diffusion limited aggregation. $\endgroup$ Commented Feb 4, 2014 at 17:15
  • 1
    $\begingroup$ We don't know what you mean by filaments or sub-structures. That answer referred to filaments because you asked for it! Restarting your project is not really relevant to the question here (it's your research problem). To get an answer here, you should be more specific about what exactly you want, specifics about the distribution and references (if possible). Without any of that, it looks like a "Hail Mary" question where you just throw out a complex problem and ask for code specifically for version 7, hoping that someone out there will understand exactly what you want and code it for you... $\endgroup$ Commented Feb 4, 2014 at 19:49
  • 1
    $\begingroup$ Would a collection of random walks work? Graphics3D[Table[Point@Accumulate[RandomReal[{-1, 1}, {300, 3}]], {10}], BoxRatios -> 1] $\endgroup$ Commented Feb 4, 2014 at 21:11

1 Answer 1

Reset to default
3
$\begingroup$

I found the code I used to generate the graphic you are referencing. (I thought I had deleted it.)

The code from this post is somewhat optimized, and it's made specifically for an inward growth: the particles are always started form the origin for the DLA simulation, not from a random outer position. Also, the "seed" of existing particles is a spherical shell, which made it unnecessary to handle escaping particles. Instead of rewriting this code to work with a central seed, I'm going to give you the original code I used for the image you referenced, with some caveats:

  • It is very slow. It was a quick experiment not intended to run fast. I think that Mathematica is not the right tool for doing a DLA simulation. It's good for prototyping, but the performance will be awful. Also due to the procedural nature of the algorithm, it's not much more difficult to implement this say, in C++ or Java, than in Mathematica. I recommend that if you are serious about making a DLA simulation, use a low level procedural language such as C/C++/Java/FORTRAN/Pascal/etc.

  • I tried to use only v7-compatible functions but I don't have v7. If something doesn't work, let me know which part and I'll see if there's a quick fix.

  • WARNING: If you include the Dynamic part (i.e. the Graphics3D part), it might use up all the memory and crash the front end after a while. I do not know if this is a front end bug or not. It is okay to just not evaluate that cell. In that case you won't see the structure growing in real time but the results will still be recorded.

  • If you prefer the original Point-look to the Sphere-look, just replace Translate[Sphere[{0, 0, 0}, 0.4], Dynamic@points] by Dynamic@Point[points].

The code:

points = N@{{0, 0, 0}}; nf = Nearest[points]; nd[p_] := EuclideanDistance[First@nf[p], p] (* put this in a separate cell an evaluate on its own *) Graphics3D[Translate[Sphere[{0, 0, 0}, 0.4], Dynamic@points], Axes -> True, BoxRatios -> Automatic, PlotRange -> (15 {{-1, 1}, {-1, 1}, {-1, 1}}), PlotLabel -> Dynamic@Length[points]] (* this goes in a separate cell again *) Do[ r0 = 2 Max[Max[Norm /@ points], 5]; r1 = 1.5 r0; pt = r0 Normalize@RandomReal[NormalDistribution[0,1], 3]; While[Norm[pt] < r1 && nd[pt] > 1, pt += RandomReal[NormalDistribution[0,1], 3]]; If[Norm[pt] < r1, AppendTo[points, pt]; nf = Nearest[points] ], {100000} ]

Stop the simulation when you like using Alt-.. The results computed so far will be stored in points.

Improve this answer
$\endgroup$
16
  • $\begingroup$ Hey ! That's now working like a charm! (using the Dynamic@Point[points]). Thanks a lot for sharing this ! Once the simulation has been stoped, how do I extract the points {x, y, z} coordinates ? $\endgroup$ Commented Feb 7, 2014 at 0:36
  • $\begingroup$ @Cham As I said at the very end, the results are stored in points as {{x1,y1,z1}, {x2,y2,z2}, ...}. Should have put that line at the top together with the rest of the text. I can see how one could miss it. $\endgroup$ Commented Feb 7, 2014 at 0:37
  • $\begingroup$ Yes, the process is very slow. But the animation is VERY nice, and allows the user to stop the process once the "sculpture" has a nice appearance. I think this is a great piece of code, even if it's very slow. Thanks again ! $\endgroup$ Commented Feb 7, 2014 at 0:43
  • $\begingroup$ Oh, just a stupid question : I guess that the process is really random ? I mean that restarting the process will not give the same shape, again and again, isn't ? $\endgroup$ Commented Feb 7, 2014 at 0:45
  • $\begingroup$ @Cham Just be careful! Mathematica will crash if you leave it running (with the live animation) for a long time. This is one reason I didn't post this code originally, the other being that it's so slow I couldn't make the filaments grow inwards from a large sphere (as in the other post). Actually I took this code from a bug report I sent about a crash ... $\endgroup$ Commented Feb 7, 2014 at 0:46

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.