Here's the awful code that made this (I don't condone programming this way -- my excuse is that it was 3:15 a.m.):
(* for the KSubsets function, which seems like a huge waste *) Needs["DiscreteMath`Combinatorica`"]; (* vertices of original tetrahedron, copied from Graphics`Polyhedra` *) {v1,v2,v3,v4}= {{0,0,1.73205}, {0,1.63299,-0.57735}, {-1.41421,-0.816497,-0.57735}, {1.41421,-0.816497,-0.57735}}; (* midpoint function *) mp[x1_, x2_] := 0.5 (x1 + x2); (* maketet replaces a tetrahedron with four smaller ones -- this would be better using Outer or some such thing *) SetAttributes[maketet,Listable]; maketet[tet[{v1_, v2_, v3_, v4_}]] := {tet[{v1, mp[v1,v2], mp[v1,v3], mp[v1,v4]}], tet[{v2, mp[v1,v2], mp[v2,v4], mp[v2,v3]}], tet[{v3, mp[v1,v3], mp[v3,v4], mp[v3,v2]}], tet[{v4, mp[v1,v4], mp[v2,v4], mp[v3,v4]}]}; (* makepolyrules creates the polygons that make up a tetrahedron -- if I were smart I'd create only the polygons visible from the viewer's viewpoint *) makepolyrules = tet[{a_, b_, c_, d_}] -> With[{verts = KSubsets[{a,b,c,d}, 3]}, Map[Polygon, verts]]; Show[GraphicsArray[ Partition[ Graphics3D[#, Boxed->False, ViewPoint->{2.344, -2.386, 0.514}]&/@ NestList[maketet, tet[{v1,v2,v3,v4}], 3] /. makepolyrules, 2]]];
Designed and rendered using Mathematica 2.2 and 3.0 for the Apple Macintosh.
Copyright © 1996/7 Robert M. Dickau