Sierpinski tetrahedron

Back to Robert's Math Figures
Starting with a simple tetrahedron, repeatedly place four tetrahedra with half the previous edge length at the four corners of the original. The result is an approximation to the Sierpinski tetrahedron.

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 *)


(* vertices of original tetrahedron, copied from Graphics`Polyhedra` *)

    {{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 *)


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]];

      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.

[Privacy Policy] [Terms of Use]

Home || The Math Library || Quick Reference || Search || Help 

© 1994- The Math Forum at NCTM. All rights reserved.

Copyright © 1996/7 Robert M. Dickau