# How to generate this fractal-like 3D distribution of points in Mma 7.0?

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

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.

-
Since the image looks MMA-made, do you happen to have a reference or (even better) some code to show for it? –  Yves Klett Feb 4 at 17:10
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. –  Cham Feb 4 at 17:15
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. –  Szabolcs Feb 4 at 17:15
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... –  rm -rf Feb 4 at 19:49
Would a collection of random walks work? Graphics3D[Table[Point@Accumulate[RandomReal[{-1, 1}, {300, 3}]], {10}], BoxRatios -> 1] –  Simon Woods Feb 4 at 21:11

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.

-
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 ? –  Cham Feb 7 at 0:36
@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. –  Szabolcs Feb 7 at 0:37
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 ! –  Cham Feb 7 at 0:43
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 ? –  Cham Feb 7 at 0:45
@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 ... –  Szabolcs Feb 7 at 0:46