How to generate apart or non-intersecting spheres in cube?

Question

I am trying to generate model of randomly distributed uniform spheres in the cube. For randomly distributed spheres I am using RandomReal option. But when I run the program I obtain a cube with several spheres located either inside each other or have intersections. Is there any way to make them apart and non-intersecting?

Here is a code of this problem:

cube = {Opacity[0.3], Cuboid[{0, 0, 0}, {20, 20, 20}]};
spheres = Table[{Green, Sphere[RandomReal[{1, 20-1}, 3], 1]}, {j, 1, 100}];
gr = Graphics3D[{cube, spheres}]

Mathematica graphics

I'd use the code from the bottom of The Mathematica One-Liner Competition :p — Kuba, Oct 07 '14 at 17:55
With your code I only see an average of about 3 collisions. Generate perhaps 110 spheres, eliminate collisions from the list and take the first 100. Should take you a fraction of a second and you are done. That probably slightly dirties your uniform distribution, but probably not enough to be able to detect. — Bill, Oct 07 '14 at 18:14
Welcome to Mathematica.SE! I suggest the following:

As you receive help, try to give it too, by answering questions in your area of expertise.

Read the [faq]!

When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge.

Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! — Dr. belisarius, Oct 07 '14 at 18:34

score 3 · Answer 1 · answered Oct 07 '14 at 18:44

3

Keep a list of the locations you add - draw from a uniform distribution and only add to the list if it doesn't overlap.

cube = {Opacity[0.3], Cuboid[{0, 0, 0}, {20, 20, 20}]};

newLocation[existing_]:= Module[{try,count=1},
  While[
    try=RandomReal[{1,19},3];
    Min[EuclideanDistance[try,#[[1]]]&/@existing]<2,
    count++
  ];
  {try,count}
]

makeLocations[n_]:=Module[{list={},loc},
  Do[
    loc=newLocation[list];
    AppendTo[list,loc],
    {n}
  ];
  list
]

spheres={Green,Sphere[#[[1]],1]&/@makeLocations[100]};

gr = Graphics3D[{cube, spheres}]

answered Oct 07 '14 at 18:44

SEngstrom

1,711
12
14

But does take quadratic time :( – Igor Rivin Oct 07 '14 at 19:25
You could use this idea – Dr. belisarius Oct 07 '14 at 19:34
You could use octtrees perhaps if you needed to optimize the search for overlapping spheres. – SEngstrom Oct 07 '14 at 20:23
Thank you very much for your helping. Bakha – Bakha Oct 07 '14 at 21:54

How to generate apart or non-intersecting spheres in cube?

1 Answers1