Pensieve Header: Programs to generate pictures of the barycentric subdivision and of the prizm construction, written for my summer class on <a href=http://www.math.toronto.edu/~drorbn/classes/0910/Homology>Homology</a>, Accra, Ghana, June 2010.

del[s_Simplex] := Table[
Delete[s, i],
{i, Length[s]}
];
del[expr_] := expr /. s_Simplex :> del[s];
cone[a_, s_Simplex] := Prepend[s, a];
cone[a_, expr_] := expr /. s_Simplex :> cone[a, s];
B[Simplex[v_]] := Simplex[v];
B[s_Simplex] := cone[Expand[Mean[List @@ s]], B[del[s]]];
B[expr_] := expr /. s_Simplex :> B[s];

B[Simplex[e0,e1,e2]]

Draw2D[ss_] := Module[
{rule, mat},
rule = Thread[{e0,e1,e2} -> (({{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}))];
mat=Drop[Orthogonalize[(({{1, 1, 1}, {0, 1, 0}, {0, 0, 1}}))], 1];
Graphics[ss /. s_Simplex :> {
RGBColor[Random[], Random[], Random[]],
Polygon[mat.(# /.rule)& /@ List @@ s]
}]
]

b21=Draw2D[B[Simplex[e0,e1,e2]]]

b22=Draw2D[B[B[Simplex[e0,e1,e2]]]]

b23=Draw2D[B[B[B[Simplex[e0,e1,e2]]]]]

Draw3D[ss_] := Module[
{rule, mat, z, r, t},
mat=IdentityMatrix[4];
rule = Thread[{e0,e1,e2, e3} -> mat];
mat=Drop[Orthogonalize[ReplacePart[mat, {1,1,1,1}, 1]], 1];
z=2Random[]-1; r=Sqrt[1-z^2];
t = 2Pi Random[];
Graphics3D[{
 Opacity[0.5],
Union[Flatten[ss]] /. s_Simplex :> {
Hue[Random[]],
Polygon[mat.(# /.rule)& /@ List @@ s]
}
},
Boxed -> False, ViewPoint -> 3{r Cos[t], r Sin[t], z}
]
]

b31=Draw3D[del[B[Simplex[e0,e1,e2, e3]]]]

b32=Draw3D[del[B[B[Simplex[e0,e1,e2, e3]]]]]

{f0,f1,f2} = {{1,0,0,0}, {0,1,0,0}, {0,0,1,0}};
{g0, g1, g2} = {{1,0,0,1}, {0,1,0,1}, {0,0,1,1}};

p=Draw3D[del@{
Simplex[f0,f1,f2, g2], Simplex[f0,f1,g1,g2], Simplex[f0,g0,g1,g2]
}
]

ShrinkTo[p_, s_Simplex] := Module[
{b=(1-p)Mean[List @@s]},
Expand[p#+b]& /@ s
];
ShrinkTo[p_, expr_] := expr /. s_Simplex :> ShrinkTo[p, s]

b31s=Draw3D[del[ShrinkTo[0.7, B[Simplex[e0,e1,e2, e3]]]]]

b32s=Draw3D[del[ShrinkTo[0.7,B[ShrinkTo[0.7,B[Simplex[e0,e1,e2, e3]]]]]]]

ps=Draw3D[del[ShrinkTo[0.7,{
Simplex[f0,f1,f2, g2], Simplex[f0,f1,g1,g2], Simplex[f0,g0,g1,g2]
}
]]]

SetDirectory["C:/drorbn/AcademicPensieve/2010-06/"];
SaveImage[fname_String, img_] := Export[fname,
ImageCrop[Rasterize[img, ImageSize -> {1600, 1600}]]
];
SaveImage["BarycentricSubdivision2D-1.png", b21];
SaveImage["BarycentricSubdivision2D-2.png", b22];
SaveImage["BarycentricSubdivision2D-3.png", b23];
SaveImage["BarycentricSubdivision3D-1.png", b31];
SaveImage["BarycentricSubdivision3D-1-Shrank.png", b31s];
SaveImage["BarycentricSubdivision3D-2.png", b32];
SaveImage["BarycentricSubdivision3D-2-Shrank.png", b32s];
SaveImage["Prizm.png", p];
SaveImage["Prizm-Shrank.png", ps];