2
$\begingroup$

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

$\endgroup$
4
  • 2
    $\begingroup$ I'd use the code from the bottom of The Mathematica One-Liner Competition :p $\endgroup$
    – Kuba
    Oct 7 '14 at 17:55
  • $\begingroup$ 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. $\endgroup$
    – Bill
    Oct 7 '14 at 18:14
  • 1
    $\begingroup$ 5478 $\endgroup$
    – Kuba
    Oct 7 '14 at 18:20
  • 1
    $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) 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! $\endgroup$ Oct 7 '14 at 18:34
3
$\begingroup$

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}]
$\endgroup$
4
  • $\begingroup$ But does take quadratic time :( $\endgroup$
    – Igor Rivin
    Oct 7 '14 at 19:25
  • $\begingroup$ You could use this idea $\endgroup$ Oct 7 '14 at 19:34
  • $\begingroup$ You could use octtrees perhaps if you needed to optimize the search for overlapping spheres. $\endgroup$
    – SEngstrom
    Oct 7 '14 at 20:23
  • $\begingroup$ Thank you very much for your helping. Bakha $\endgroup$
    – Bakha
    Oct 7 '14 at 21:54

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