(* Mathematica Graphics3D program for A047773 examples. This program produces three examples (4, 7, and 8 cells) of the tetrahedral clusters with symmetry type D. The output can be manipulated with the cursor to rotate the figures. *) newp[a_, b_, c_, d_ ] := 2 (a + b + c)/3 - d; p1 = {0, 0, 0}; p2 = {0, 1, 1}; p3 = {1, 0, 1}; p4 = {1, 1, 0}; p5 = newp[p1, p2, p3, p4]; p6 = newp[p1, p2, p4, p3]; p7 = newp[p1, p4, p3, p2]; q1 = p1 + {0, -2, 2}; q2 = p2 + {0, -2, 2}; q3 = p3 + {0, -2, 2}; q4 = p4 + {0, -2, 2}; q5 = p5 + {0, -2, 2}; q6 = p6 + {0, -2, 2}; q7 = p7 + {0, -2, 2}; q8 = newp[q2, q3, q5, q1]; q9 = newp[q2, q4, q6, q1]; q10 = newp[q4, q3, q7, q1]; r1 = q1 + {0, -2, 2}; r2 = q2 + {0, -2, 2}; r3 = q3 + {0, -2, 2}; r4 = q4 + {0, -2, 2}; r5 = q5 + {0, -2, 2}; r6 = q6 + {0, -2, 2}; r7 = q7 + {0, -2, 2}; r8 = q8 + {0, -2, 2}; r9 = q9 + {0, -2, 2}; r10 = q10 + {0, -2, 2}; r11 = newp[r2, r3, r4, r1]; Show[Graphics3D[{{RGBColor[0, 1, 0], Sphere[{p1, p2, p3, p4, p5, p6, p7, q1, q2, q3, q4, q5, q6, q7, q8, q9, q10, r1, r2, r3, r4, r5, r6, r7, r8, r9, r10}, 0.05]}, {RGBColor[1, 0.6, 0.6], Cylinder[{{p2, p3}, {p2, p4}, {p3, p4}, {q2, q3}, {q2, q4}, {q3, q4}, {r2, r3}, {r2, r4}, {r3, r4}}, 0.025]}, {RGBColor[0, 1, 0], Sphere[{r5, r8}, 0.0]}, {RGBColor[0.6, 0.6, 1], Cylinder[{{p1, p2}, {p1, p3}, {p1, p4}, {p2, p5}, {p3, p5}, {p1, p5}, {p2, p6}, {p1, p6}, {p4, p6}, {p3, p7}, {p1, p7}, {p4, p7}, {q1, q2}, {q1, q3}, {q1, q4}, {q2, q5}, {q3, q5}, {q1, q5}, {q2, q6}, {q1, q6}, {q4, q6}, {q3, q7}, {q1, q7}, {q4, q7}, {q2, q8}, {q3, q8}, {q5, q8}, {q2, q9}, {q4, q9}, {q6, q9}, {q3, q10}, {q4, q10}, {q7, q10}, {r1, r2}, {r1, r3}, {r1, r4}, {r2, r5}, {r3, r5}, {r1, r5}, {r2, r6}, {r1, r6}, {r4, r6}, {r3, r7}, {r1, r7}, {r4, r7}, {r2, r8}, {r3, r8}, {r5, r8}, {r2, r9}, {r4, r9}, {r6, r9}, {r3, r10}, {r4, r10}, {r7, r10}, {r2, r11}, {r3, r11}, {r4, r11}}, 0.025]}}], Boxed -> False, ViewPoint -> {3, 4, 5}]