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

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:
http://profile.imeem.com/GUmj0c/photo/yLSNmE-k/boadA-WWGt/
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]