Tetrix

Author

Eric W. Weisstein
February 2, 2011

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Fractals/Tetrix.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Tetrix.html.

©2010 Wolfram Research, Inc. except for portions noted otherwise

Graphics

V6

<<Utilities`LiveGraphics3D`

Do[WriteLiveForm["tetrix"<>ToString[i]<>".m",Show[Tetrix[i],Boxed->False,ViewPoint->{3,-1,0},ViewVertical->{1,1,1},DisplayFunction->Identity]],{i,3}]

Show[GraphicsArray[Table[Show[Tetrix[i],DisplayFunction->Identity,ViewPoint->{3,-1,0},ViewVertical->{1,1,1},Boxed->False],{i,3}]]]

Show[GraphicsArray[Table[Show[Graphics3D[Tetrix[1],ViewPoint->{i,i,10},Boxed->False,DisplayFunction->Identity]],{i,2,0,-1}]],DisplayFunction->$DisplayFunction]

V6

GraphicsRow[Table[Show[Tetrix[i],DisplayFunction->Identity,ViewPoint->{3,-1,0},ViewVertical->{1,1,1},Boxed->False],{i,3}],Spacings->-50]

SierpinskiMesh

SierpinskiMesh[3,3]

Graphics3D[%35]

MeshCoordinates[SierpinskiMesh[3,3]][[{1,35}]]

MeshRegion[SierpinskiMesh[3,3],MeshCellLabel->{0->"Index"}]

Graphics3D[{SierpinskiMesh[3,3],PointSize[.1],Point[{1/2,0,0}]}]

Table[Mean[MeshCoordinates[SierpinskiMesh[i,3]]],{i,4}]

RootApproximant[0.2886751345948128`,2]

N[%]

RootApproximant[0.20412414523193143`,2]

N[%]

Manipulate[
Graphics3D[{FaceForm[],tet},Boxed->False,SphericalRegion->True,ViewPoint->-20RotationMatrix[θ,{1.,0.,0.}].{0,(1/(2 (Sqrt[3]))),(1/(2 (Sqrt[6])))}],{{θ,0.,"View Point"},0,Pi/4},LabelStyle->{Magnification->1.3},Initialization:>(tet=SierpinskiMesh[3,3])]

Bernat

Manipulate[With[{vp=RotationTransform[θ,{1,1,1}][{0,0,3}]},Graphics3D[{FaceForm[],{Triangle[#[[;;-2]]],Triangle[#[[2;;]]],Line[{#[[1]],#[[-1]]}]}&/@Nest[Flatten[{t[[1]][#],t[[2]][#],t[[3]][#],t[[4]][#]},1]&,{v},3]},Boxed->False,ViewPoint->vp+{0,0,10},ViewVertical->{0,0.69,0.724},SphericalRegion->True]],{{θ,0,"View Point"},0,2Pi},
LabelStyle->{Magnification->1.3},SaveDefinitions->True,
Initialization:>(
v={{-1,0,-(1/(Sqrt[2]))},{0,-1,(1/(Sqrt[2]))},{0,1,(1/(Sqrt[2]))},{1,0,-(1/(Sqrt[2]))}};
t=Map[ScalingTransform[{1/2,1/2,1/2},#]&,v];

v2=CirclePoints[3];t2=Map[ScalingTransform[{1/2,1/2},#]&,v2];)]

Recursive

TetraVec[i_]:=2 IntegerDigits[3 i-2,2,3]-1
tetrix[-1,p_:{0,0,0}]:=Polygon/@Array[TetraVec[#]+p&/@Delete[Range[4],#]&,4]
tetrix[n_,p_:{0,0,0}]:=Array[tetrix[n-1,p+TetraVec[#] 2^n]&,4]
Tetrix[n_,p_:{0,0,0}]:=tetrix[n-1,p]
Manipulate[
Graphics3D[{FaceForm[],Tetrix[3]},Boxed->False,SphericalRegion->True,ViewPoint->{1-Cos[θ]+(Sqrt[3]) Sin[θ],1-Cos[θ]-(Sqrt[3]) Sin[θ],1+2 Cos[θ]+10},ViewVertical->{0,0.69,0.724}],{{θ,0,"View Point"},0,2Pi},
LabelStyle->{Magnification->1.3},SaveDefinitions->True,
]