Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Split-up "binomial cube"

• To: mathgroup at smc.vnet.net
• Subject: [mg121344] Split-up "binomial cube"
• From: "Christopher O. Young" <cy56 at comcast.net>
• Date: Mon, 12 Sep 2011 04:18:41 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com

Trying to implement a familiar illustration of the binomial expansion (3rd
degree, in this case) via a cube partitioned into various blocks, all based
on a unit block.  

Would it be a better idea to separate out the plotting from the graphics
data? I.e., not use Show[ ] in my binomCube function? I'd like to be able to
pass in various options, and I'm not sure I can get them in if I have
plotting commands.

There's a picture at http://home.comcast.net/~cy56/binomCube.png

Chris Young
cy56 at comcast.net


rect[P_, x_, y_, z_, s_, g_, H_] :=
 Graphics3D[
  Table[
   {
    Opacity[0.75],
    Hue[H],
    Cuboid[P + {i, j, k}, P + {i, j, k} + s - g]
    },
   {k, 0, z - s},
   {j, 0, y - s},
   {i, 0, x - s}
   ]
  ]
  
  
 Manipulate[
 Show[
  rect[{0, 0, 0}, 2, 2, 2, 1, g, {0, 0.5, 1}],
  
  rect[{2 + o, 0, 0}, 1, 2, 2, 1, g, {0.15, 0.5, 1}],
  rect[{0, 2 + o, 0}, 2, 1, 2, 1, g, {0.15, 0.5, 1}],
  rect[{0, 0, 2 + o}, 2, 2, 1, 1, g, {0.15, 0.5, 1}],
  
  rect[{0, 2 + o, 2 + o}, 2, 1, 1, 1, g, {0.6, 0.5, 1}],
  rect[{2 + o, 0, 2 + o}, 1, 2, 1, 1, g, {0.6, 0.5, 1}],
  rect[{2 + o, 2 + o, 0}, 1, 1, 2, 1, g, {0.6, 0.5, 1}],
  
  rect[{2 + o, 2 + o, 2 + o}, 1, 1, 1, 1, g, {0.8, 0.5, 1}],
  
  Axes -> True,
  Lighting -> "Neutral",
  SphericalRegion -> True
  ],
 {{g, 0.1, "Gap"}, 0, 1},
 {{o, 0.5, "Offset"}, 0, 1}
 ]
 
 binomCube[P_, w_, s_, o_, g_] :=
 Show[
  {
   rect[P, w s, w s, w s, s, g, {0, 0.5, 1}],
   
   rect[P + {w s + o, 0, 0}, s, w s, w s, s, g, {0.2, 0.5, 1}],
   rect[P + {0, w s + o, 0}, w s, s, w s, s, g, {0.2, 0.5, 1}],
   rect[P + {0, 0, w s + o}, w s, w s, s, s, g, {0.2, 0.5, 1}],
   
   rect[{0, w + o, w + o}, w s, s, s, s, g, {0.5, 0.5, 1}],
   rect[{w + o, 0, w + o}, s, w s, s, s, g, {0.5, 0.5, 1}],
   rect[{w + o, w + o, 0}, s, s, w s, s, g, {0.5, 0.5, 1}],
   
   rect[{w + o, w + o, w + o}, s, s, s, s, g, {0.8, 0.5, 1}]
   },
  
  Axes -> True,
  Lighting -> "Neutral",
  SphericalRegion -> True
  ]
  
  
  Displaying a grid of different binomial cubes:

{
 binomCube[{0, 0, 0}, 1, 1, 0.5, 0.1],
 binomCube[{0, 0, 0}, 2, 1, 0.5, 0.1],
 binomCube[{0, 0, 0}, 3, 1, 0.5, 0.1]
 }