Re: Cube codes just done in Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg80058] Re: Cube codes just done in Mathematica
• From: Roger Bagula <rlbagula at sbcglobal.net>
• Date: Sat, 11 Aug 2007 02:17:55 -0400 (EDT)
• References: <f943dr\$m35\$1@smc.vnet.net>

```Picture of the level three outputs:
Mathematica: triangular Prism
Clear[pieces, menger]
p = {{0, 2, 0}, {1, 1, 0}, {1, 3, 0}, {2, 0, 0}, {2, 4, 0}, {2, 2, 0}};
p1 = {{0, 2, 2}, {1, 1, 2}, {1, 3, 2}, {2, 0, 2}, {2, 4, 2}, {2, 2, 2}};
p2 = {{0, 2, 1}, {2, 0, 1}, {2, 4, 1}};
pieces = Join[p, p1, p2];
Length[pieces]
N[Log[Length[pieces]]/Log[3]]
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[],  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]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]

Mathematica: diagonal Menger cube
Clear[pieces, menger]
p = {{0, 2, 0}, {1, 1, 0}, {1,
3, 0}, {2, 0, 0}, {2, 4, 0}, {3, 1, 0}, {3, 3, 0}, {4, 2, 0}};
p1 = {{0, 2, 2}, {1, 1, 2}, {1, 3, 2}, {2, 0, 2}, {2, 4, 2}, {3, 1,
2}, {3, 3, 2}, {4, 2, 2}};
p2 = {{0, 2, 1}, {2, 0, 1}, {2, 4, 1}, {4, 2, 1}};
pieces = Join[p, p1, p2];
Length[pieces]
N[Log[Length[pieces]]/Log[3]]
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[],  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]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]

Mathematica:Hexagon
Clear[pieces, menger]
p = {{0, 2, 0}, {1, 1,
0}, {1, 3, 0}, {2, 0, 0}, {3, 0, 0}, {4, 0, 0}, {2, 4, 0}, {3, 4, 0}, {4,
4, 0}, {5, 1, 0}, {5, 3, 0}, {6, 2, 0}};
p1 = {{0, 2, 2}, {1, 1, 2}, {1, 3, 2}, {2, 0, 2}, {3, 0, 2}, {4, 0,
2}, {2, 4, 2}, {3, 4, 2}, {4, 4, 2}, {5, 1, 2}, {5, 3, 2}, {6, 2, 2}};
p2 = {{0, 2, 1}, {2, 0, 1}, {4, 0, 1}, {2, 4, 1}, {4, 4, 1}, {6, 2, 1}};
pieces = Join[p, p1, p2];
Length[pieces]
N[Log[Length[pieces]]/Log[3]]
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[],  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]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]

Picture of level 3 Octagon at:
http://profile.imeem.com/GUmj0c/photo/yLSNmE-k/TgEyoDeAsF/
Mathematica: octagon
Clear[pieces, menger]
p = {{0, 2, 0}, {0, 3,
0}, {0, 4, 0}, {1, 1, 0}, {1, 5, 0}, {2, 0, 0}, {3, 0, 0}, {4, 0, 0}, {2,
6, 0}, {3, 6, 0}, {4, 6, 0}, {5, 1, 0}, {5, 5, 0}, {6, 2, 0}, {6,
3, 0}, {6, 4, 0}};
p1 = {{0, 2, 2}, {0, 3, 2}, {0, 4, 2}, {1, 1, 2}, {1, 5, 2}, {2, 0,
2}, {3, 0, 2}, {4, 0, 2}, {2, 6, 2}, {3, 6, 2}, {4, 6, 2}, {5, 1,
2}, {5, 5, 2}, {6, 2, 2}, {6, 3, 2}, {6, 4, 2}};
p2 = {{0, 2, 1}, {0,
4, 1}, {2, 0, 1}, {4, 0, 1}, {2, 6, 1}, {4, 6, 1}, {6, 2, 1}, {6, 4, 1}};
pieces = Join[p, p1, p2];
Length[pieces]
40
menger[cornerPt_, sideLen_, n_] :=
menger[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & /@ pieces;
menger[cornerPt_, sideLen_, 0] :=
{EdgeForm[],  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]
Show[Graphics3D[Flatten[menger[{0, 0, 0}, 1, 3]]], Boxed -> False]

```

• Prev by Date: Re: Re: Working with factors of triangular numbers.
• Next by Date: Re: Re: Working with factors of triangular numbers.
• Previous by thread: Cube codes just done in Mathematica
• Next by thread: Re: Re: request for a few minutes CPU-time