0
$\begingroup$

The code below creates a random distribution of points in 3D. Currently, the points have a random size, and the size is the same for all points. I need the points to get individually a random size, not the same for all points. How can I modify that code to do that? Please, the solution should work with old versions of Mathematica (I'm still using version 7.0 since my computer is very old). The colors could be random too, but I want to concentrate on the size first.

points3D[p_, q_, r_] := Module[{dat = RandomReal[{-1, 1}, {p, 3}]},
Do[AppendTo[dat, r RandomReal[{-1, 1}, 3] + RandomChoice[dat]], {i, q}]; dat
]

graph3D[p_, q_, r_] := Graphics3D[{RGBColor[{0.5, 0.4, 1.0, 0.4}], PointSize[RandomReal[{0.004, 0.01}]], Point[points3D[p, q, r]]}]

view[p_, q_, r_] := Show[{graph3D[p, q, r]},
    PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
    Boxed -> True,
    Background -> Black,
    ImageSize -> {700, 700},
    SphericalRegion -> True,
    Method -> {"RotationControl" -> "Globe"}
]

view[200, 5000, 0.1]

Preview of what this code is doing:

enter image description here

As you can notice on this picture, the points are all having the same size. I need them to get different random sizes.

$\endgroup$
11
  • 1
    $\begingroup$ Each Point must have its own PointSize. Change definition of graph3D to graph3D[p_, q_, r_] := Graphics3D[{RGBColor[{0.5, 0.4, 1.0, 0.4}], {PointSize[RandomReal[{0.004, 0.01}]], Point[#]} & /@ points3D[p, q, r]}] $\endgroup$
    – Bob Hanlon
    Jul 29 at 18:17
  • $\begingroup$ @BobHanlon, I'm getting a problem with your solution. As is, it's working great. But as soon as I put it in a manipulate box to play with the variables (p, q, r), Mathematica aborts the compilation after some delay. There's something fishy. Is there another way in writing your suggestion, without the &/@ (which appears to give troubles to my old version of Mma) $\endgroup$
    – Cham
    Jul 29 at 18:30
  • $\begingroup$ Turn off synchronous updating, i.e., Manipulate[view[p, q, r], {{p, 200}, 100, 300, 5, Appearance -> "Labeled"}, {{q, 5000}, 2000, 8000, 1000, Appearance -> "Labeled"}, {{r, 0.1}, 0.05, 0.2, 0.05, Appearance -> "Labeled"}, TrackedSymbols :> All, SynchronousUpdating -> False] $\endgroup$
    – Bob Hanlon
    Jul 29 at 18:41
  • $\begingroup$ {PointSize[RandomReal[{0.004, 0.01}]], Point[#]} & /@ points3D[p, q, r] is the same as Map[{PointSize[RandomReal[{0.004,0.01}]], Point[#]}&, points3D[p,q,r]] $\endgroup$
    – Bob Hanlon
    Jul 29 at 18:46
  • 1
    $\begingroup$ AppendTo is inefficient, use Table and Join, i.e., points3D[p_, q_, r_] := Module[{dat = RandomReal[{-1, 1}, {p, 3}]}, Join[dat, Table[r RandomReal[{-1, 1}, 3] + RandomChoice[dat], {i, q}]]] $\endgroup$
    – Bob Hanlon
    Jul 29 at 20:16

2 Answers 2

2
$\begingroup$
getPts[n_, noise_] := 
 Module[{dat = RandomReal[{-1, 1}, {20, 3}]}, 
  Do[AppendTo[dat, noise RandomReal[{-1, 1}, 3] + RandomChoice[dat]], 
   n]; {PointSize[RandomReal[{0.003, 0.006}]], Point[#]} & /@ dat] 

Manipulate[
 Graphics3D[getPts[n, noise], 
  PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}], {{noise, 0.1}, 0, 
  0.4}, {{n, 1000}, 100, 5000}]

enter image description here

$\endgroup$
7
  • $\begingroup$ Your suggestion gives me the same trouble as Bob: the &/@ appears to stop the compilation (while I checked all the code). Mma just $Abort the compilation, I don't know why. $\endgroup$
    – Cham
    Jul 29 at 18:37
  • $\begingroup$ I have MMA version 13.1 Maybe we have a version problem. Try e.g. getPts[100,1] and see if you get some reasonable output like: {{PointSize[0.00524523], Point[{0.153324, -0.916432, 0.910523}]},....`` $\endgroup$ Jul 29 at 18:42
  • $\begingroup$ The compilation of your code (without modifications) is extremely slow on my system. Yes I get something like in your previous comment... $\endgroup$
    – Cham
    Jul 29 at 18:43
  • $\begingroup$ To get 1000 points it takes 0.015 sec on a not too new PC. $\endgroup$ Jul 29 at 18:46
  • $\begingroup$ It now works (using Bob suggestion of SynchronousUpdating -> False) but it's extremely slow! There's surely another way of adding random Sizes. Maybe at the level of dat = RandomReal[{-1, 1}, {p, 3}] $\endgroup$
    – Cham
    Jul 29 at 19:05
0
$\begingroup$

You might get better performance if you avoid the Module and Do loop:

points3D[locusCount_, cloudPointCount_, cloudRadius_] :=
  With[
    {locii = RandomReal[{-1, 1}, {locusCount, 3}]},
    randomCloudPoint[cloudRadius] /@ RandomChoice[locii, cloudPointCount]]

We determine the cloud "centers" or "locii" and then generate a random sample of them which we will then map our "fuzzing" function over. I introduced a function randomCloudPoint for this:

randomCloudPoint[radius_][locus_] := locus + RandomReal[{-radius, radius}, 3]

This gives a uniform distribution. You could use different distributions (not sure what's available in your version):

randomCloudPoint[radius_][locus_] := 
  locus + RandomVariate[NormalDistribution[0, radius/3], 3]

I used SubValues to make the mapping part simpler.

Now, as has previously been mentioned/demonstrated, you need to come up with a style for each point. I put this into another function:

randomPointStyle[ptSizeRange_, baseColor_, colorRange_][pt_] := 
  {PointSize[RandomReal[ptSizeRange]], 
   Darker[baseColor, RandomReal[{-colorRange, colorRange}]],
   Point[pt]}

There would be other ways to randomize the color.

The new graph3D looks like this:

graph3D[p_, q_, r_] := 
  Graphics3D[randomPointStyle[{.001, .01}, RGBColor[{0.5, 0.4, 1.0, 0.8}], .5] /@ points3D[p, q, r]]

(Didn't rename the arguments this time.) I changed the opacity a bit so the color variation was more obvious.

Here's a Manipulate:

Manipulate[
  view[locusCount, totalCount, cloudRadius], 
  {{locusCount, 20}, 1, 200, 1}, 
  {{totalCount, 500}, 1, 5000, 1}, 
  {{cloudRadius, .1}, .01, .5}]

(I didn't change view, but it would depend on the new functions above.)

$\endgroup$
1
  • $\begingroup$ I'm still having $Aborted issue. Without a random Size, my code was working great. Adding the random size gives the same issue. $\endgroup$
    – Cham
    Jul 29 at 19:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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