# Plotting a Sphericon and Bipyramid with 100 faces

I would like to plot a convex polyhedron with 100 faces, which could be used as a die. My first attempt was asking for Conway's Hecatohedron. Unfortunately, it can not be used as a die.

Now, there are two objects which would satisfy what I need, and I would like to know how to plot them in Mathematica:

1) A 100 faces Sphericon. A picture can be seen here.

2) A Bipyramid with 100 faces.

And a follow-up question: Are there other objects which could represent 100-sided dice? Maybe a generalisation of Archimedean solids?

• Although you can use these as die, they are not fair die. In order to be fair the dice should be both orthohedral and equispherical. If someone were to spin this die with either point down they might influence the roll. A fair die gives a statistically linear distribution. There is a fair die shape with 120 sides, but not 100. You might cut 100 facets on a sphere? May 26, 2014 at 0:05

Graphics3D[
{GraphicsComplex[
Join[{Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/(50)], {{0, 0, 1}}],
{GeometricTransformation[Polygon[{##, 52} & @@@ Partition[Range[51], 2, 1]],
{IdentityMatrix[3], ScalingTransform[{1, 1, -1}]}]
}]}]


Graphics3D[{GraphicsComplex[
Join[{Cos[#], Sin[#], 0} & /@ Range[0, Pi, Pi/(25)], {{0, 0, 1}}],
{
{#, Rotate[Rotate[#, 180 °, {0, 0, 1}], 90 °, {0, 1, 0}]} &[
GeometricTransformation[Polygon[{##, 27} & @@@ Partition[Range[26], 2, 1]],
{IdentityMatrix[3], ScalingTransform[{1, 1, -1}]}]
]
}]}]


• Very nice, thank you. Do you also know how to generate a sphericon? May 25, 2014 at 8:45
• @Mario Is this what you are after?
– Kuba
May 25, 2014 at 8:56
• Yes, wow. Beautiful! Thanks alot. Now i need to understand it :) May 25, 2014 at 9:06
• @Mario Feel free to ask if you face any problems. Also, it is good to hold on about a day with an accept, better answers may appear, let's do not discourage others. You can still upvote the anser (+1) if you like it. ;)
– Kuba
May 25, 2014 at 9:09
• @Kuba See here for the follow-up of your code :) Thanks alot again! Jul 13, 2014 at 12:43
styles = {MeshFunctions -> {#4/(Pi) &}, Mesh -> {Range[-1, 1, .05]},
BoundaryStyle -> Black,  ImageSize -> 600, Boxed -> False, Axes -> False,
PlotStyle ->  Directive[Orange, Opacity[0.9], Specularity[White, 30]]};

ParametricPlot3D[{{v Sin[u], v Cos[u], v - 1}, {v Sin[u], v Cos[u], 1 - v}},
{u, -Pi, Pi}, {v, 0, 1}, Evaluate@styles]


ParametricPlot3D[{ConditionalExpression[{{v Sin[u], v Cos[u],v - 1},
{v Sin[u], v Cos[u], 1 - v}}, u <= 0],
ConditionalExpression[{{v Sin[u], v - 1, v Cos[u]},
{v Sin[u], 1 - v, v Cos[u]}}, u > 0]},
{u, -Pi, Pi}, {v, 0, 1}, Evaluate@styles]


Here is some code for generating a bipyramid:

With[{n = 100},
Graphics3D[GraphicsComplex[Join[{{0, 0, 1}},
{{0, 0, -1}}],
With[{ed = Partition[Range[2, n/2 + 1], 2, 1, 1]},
{Automatic, 3}, n/2 + 2]]]}]],
Boxed -> False]]


Making a sphericon is a little trickier. A slight modification of the code above produces the following:

With[{n = 100},
Block[{h = n/2, q = n/4, h1, h2, i1, i2},
{h1, h2} = TakeDrop[PadRight[CirclePoints[{1, 0}, h], {Automatic, 3}], q + 1];
h2 = Join[{{0, 0, 1}}, RotationTransform[π/2, {0, 1, 0}][h2], {{0, 0, -1}}];
{i1, i2} = TakeDrop[Range[h + 2], q + 1];
Graphics3D[GraphicsComplex[Join[h1, h2],
{Polygon[Join[
PadRight[Partition[i1, 2, 1], {Automatic, 3}, q + 2],