3
$\begingroup$

I'm looking for a nice one- or two-liner to randomly place some number, $N$, of Graphics3D polytopes on a plane with dimensions $X \times Y$, and to specify that $k \leq N$ of them should be one color (e.g. Red) and the remaining $N-k$ another color (e.g. Blue). If possible, I would also like the option to randomly reassign colors an arbitrary number of times (perhaps by clicking a mouse) without changing the coordinates of the polytopes. Is this possible?

We can get started by placing a single red colored Dodecahedron at the coordinate $(0,0,0)$ with the following line of code:

Graphics3D[{Red, Scale[Translate[PolyhedronData["Dodecahedron", "Faces"], {0, 0, 0}], 3]},
          Boxed -> False, Background -> Gray]

Perhaps we would want to use Map here?

$\endgroup$
2
$\begingroup$

a bit long for a comment, but maybe this will get you started:

Graphics3D[
  Array[{If[# < 5, Red, Blue], 
  Scale[Translate[
  PolyhedronData[RandomChoice[PolyhedronData[]], "Faces"], 
    {RandomInteger[{-25, 25}], RandomInteger[{-25, 25}], 0}], 3]} &, 
    RandomInteger[{5, 10}]], Boxed -> True, 
    PlotRange -> {{-30, 30}, {-30, 30}, All}]

I will leave it to you to scale the numbers to your liking.

(and I couldn't find a nice solution for the mouse-clicking question)

enter image description here

$\endgroup$
3
$\begingroup$

This is fairly compact:

Module[{n = 20, k = 5, pd, polys, col},
 pd = N @ PolyhedronData["Dodecahedron", "Faces"];
 polys = Translate[pd, {##, 0}] & @@@ RandomReal[{-20, 20}, {n, 2}];
 col = Table[Red, {k}] ~Join~ Table[Blue, {n - k}];
 EventHandler[Graphics3D @ Dynamic @ Riffle[col, polys],
  {"MouseClicked" :> (col = RandomSample @ col)}]]

enter image description here

$\endgroup$
  • $\begingroup$ This is a very elegant solution. $\endgroup$ – CRJ Oct 20 '13 at 12:09
1
$\begingroup$

Far from a one-liner, I'm afraid:

number = 20;
positions = 
  Table[{RandomReal[{-20, 20}], RandomReal[{-20, 20}], 0}, {number}];
colorfunction[n_, k_] := If[n >= k, Red, Blue];
Manipulate[
 Graphics3D[
  Table[{
    colorfunction[c, k], 
    Scale[
     Translate[PolyhedronData["Dodecahedron", "Faces"], 
      positions[[c]]], 3]
    }, {c, 1, number}]],
 {k, 1, number}]

random polytopes

Notice that they overlap! Luckily you didn't specify that they couldn't... :)

Random colors:

number = 20;
positions = 
  Table[{RandomReal[{-20, 20}], RandomReal[{-20, 20}], 0}, {number}];
colorfunction[n_, k_, col1_, col2_] := If[n >= k, col1, col2];
Manipulate[
 Column[{
   Button["random",
    {colour1 = RGBColor [RandomReal[1, 3]],
     colour2 = RGBColor [RandomReal[1, 3]]}],
   Graphics3D[
    Table[{
      colorfunction[c, k, colour1, colour2], 
      Scale[
       Translate[PolyhedronData["Dodecahedron", "Faces"], 
        positions[[c]]], 3]
      }, {c, 1, number}],
    ImageSize -> {400, 400},
    PlotRange -> {{-30, 30}, {-30, 30}, All}]}],
 {{k, number/ 2}, 1, number},
 Initialization -> {colour1 = Red, colour2 = Blue}]

colored random polytopes

$\endgroup$
  • $\begingroup$ Very nice answer! Just as a note, for the random colors I meant "randomly assign the red coloration, for example, to $k$ of the objects" and "randomly assign the blue coloration to $N-k$ of the objects". Does that make sense? $\endgroup$ – CRJ Oct 20 '13 at 10:01
0
$\begingroup$

A variation on Simon's method using ClickPane:

Module[{n = 20, k = 5, pd, polys, col}, 
 pd = N@PolyhedronData["Dodecahedron", "Faces"];
 col = Table[Red, {k}]~Join~Table[Blue, {n - k}];
 polys = Translate[pd, {##, 0}] & @@@ RandomReal[{-20, 20}, {n, 2}];
 Dynamic @ ClickPane[Graphics3D @ Riffle[col, polys], (col = RandomSample @ col) &]] 

enter image description here

$\endgroup$

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.