Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

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

Search the Archive

Cube codes just done in Mathematica

  • To: mathgroup at smc.vnet.net
  • Subject: [mg79810] Cube codes just done in Mathematica
  • From: Roger Bagula <rlbagula at sbcglobal.net>
  • Date: Sun, 5 Aug 2007 04:53:17 -0400 (EDT)

These cubes came up as an answer to a question in sci.fractals.
Menger cube code By Szabolcs Horv=E1t <szhorvat at gmail.com> :
Clear[pieces, menger]
pieces =
 Complement[
  Flatten[Table[{i, j, k}, {i, 0, 2}, {j, 0, 2}, {k, 0, 2}],
   2], {{1, 1, 1}, {0, 1, 1}, {2, 1, 1}, {1, 0, 1}, {1, 2, 1}, {1, 1,
    0}, {1, 1, 2},}]
menger[cornerPt_, sideLen_, n_] :=
 menger[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
 Cuboid[cornerPt, cornerPt + sideLen*{1, 1, 1}];

gr = Flatten[menger[{0, 0, 0}, 1, 2]];
Show[Graphics3D[gr], Boxed -> False]

Cross Menger cube/ sponge:
Clear[pieces, menger]
(*Cross Menger cube by Roger Bagula 3 Aug 2007=A9*)
(* patterned from Menger cube code by Szabolcs Horv=E1t <
szhorvat at gmail.com >,
 University of Bergen in Mathematica newsgroup : Mon, 28 May 2007 09 : 10=
 :
50*)
Union[Flatten[Table[{{1, 2, i}, {2, 1, i}, {2, 2, i}, {2, 3, i}, {3,
  2, i}, {1, i, 2}, {2, i, 1}, {2, i, 2}, {2, i, 3}, {3, i, 2}, {i, 1, 2}=
,
{i, 2, 1}, {i, 2, 2}, {i, 2, 3}, {i, 3, 2}}, {i, 0, 4}], 1]]
Length[%]
N[Log[53 - %]/Log[5]]
2.690835916581937`
pieces =
 Complement[
  Flatten[Table[{i, j, k}, {i, 0, 4}, {j, 0, 4}, {k, 0, 4}],
   2], Union[Flatten[Table[{{1, 2, i}, {2, 1, i}, {2, 2, i}, {
       2, 3, i}, {3, 2, i}, {1, i, 2}, {2, i, 1}, {2, i, 2}, {2, i, 3}, {
       3, i, 2}, {i, 1, 2}, {i, 2, 1}, {i, 2, 2}, {i, 2, 3}, {i, 3, 2}}, =
{
       i, 0, 4}], 1]]]



menger[cornerPt_, sideLen_, n_] :=
 menger[cornerPt + #1*(sideLen/5), sideLen/5, n - 1] & /@ pieces
menger[cornerPt_, sideLen_, 0] :=
 Cuboid[cornerPt, cornerPt + sideLen*{1, 1, 1}]

Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 1]]], Boxed -> False]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 2]]], Boxed -> False]

Higher level M<enger cube/ sponge ( called boxed set):
Clear[pieces, menger]
(* boxed set 444 cube by Roger Bagula 3 Aug 2007 =A9*)
(* patterned from Menger cube code by Szabolcs Horv=E1t < szhorvat at gmail.=
com
 >, University of Bergen in Mathematica newsgroup : Mon, 28 May 2007 09
: 10 :
50*)
pieces =
 Complement[
  Flatten[Table[{i, j, k}, {i, 0, 3}, {j, 0, 3}, {k, 0, 3}],
   2], Union[Flatten[Table[{{1, 1, i}, {2, 1, i}, {1, 2, i}, {2, 2, i},
{1, \
i, 1}, {2, i, 1}, {1, i, 2}, {2, i, 2}, {i, 1,
   1}, {i, 2, 1}, {i, 1, 2}, {i, 2, 2}}, {i, 0, 3}], 1]]]
menger[cornerPt_, sideLen_, n_] :=
 menger[cornerPt + #1*(sideLen/4), sideLen/4, n - 1] & /@ pieces
menger[cornerPt_, sideLen_, 0] :=
 Cuboid[cornerPt, cornerPt + sideLen*{1, 1, 1}]

Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 1]]], Boxed -> False]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 2]]], Boxed -> False]



  • Prev by Date: Re: Documentation Center (v6): do-it-yourself Mathematica Book
  • Next by Date: Re: Documentation Center (v6): do-it-yourself Mathematica
  • Previous by thread: Re: gamepad graphics
  • Next by thread: Re: Cube codes just done in Mathematica