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]