# Create 9 sided dice?

Posted 2 months ago
698 Views
|
13 Replies
|
3 Total Likes
|
 G'Day Folks,I am interested in creating a (3d printed) sudoku board...I wanted to start with (something like) a 9-sided dice.I think that if you 'sliced' 9 flat faces into a sphere you'd get something like it. :) The faces would need to be the same size and equidistant; which sounds simple. But, my mathematical knowledge isn't good enough for this.I've been using Open SCAD for modelling; and have created a Dodecahedron (12 sided regular polyhedron); and I guess this would be OK - with 3 "black" faces.Does anyone have any suggestions!?cheers Steve
13 Replies
Sort By:
Posted 2 months ago
 Here comes a first guess:
Posted 2 months ago
 Hi Henrik,This has 14 faces though… MeshPrimitives[ConvexHullMesh[SpherePoints[9]], 2] // Length not the requested 9…
Posted 2 months ago
 Hi Sander,ooops, how embarrassing! Thanks for spotting!EDIT:Here comes a hopefully correct approach: I am using my 9 points of SpherePoints[9] around the origin {0,0,0} and assume the 9-dice will be the center cell of a 3D Voronoi mesh. To my great luck @Chip Hurst has provided a nice algorithm for this, so all credits should definitely go to him! pts = Append[SpherePoints[9], {0, 0, 0}]; pad[\[Delta]_][{min_, max_}] := {min, max} + \[Delta] (max - min) {-1, 1}; VoronoiCells[pts_] /; MatrixQ[pts, NumericQ] && 2 <= Last[Dimensions[pts]] <= 3 := Block[{bds, dm, conn, adj, lc, pc, cpts, hpts, hns, hp, vcells}, bds = pad[.1] /@ MinMax /@ Transpose[pts]; dm = DelaunayMesh[pts]; conn = dm["ConnectivityMatrix"[0, 1]]; adj = conn.Transpose[conn]; lc = conn["MatrixColumns"]; pc = adj["MatrixColumns"]; cpts = MeshCoordinates[dm]; vcells = Table[hpts = PropertyValue[{dm, {1, lc[[i]]}}, MeshCellCentroid]; hns = Transpose[ Transpose[cpts[[DeleteCases[pc[[i]], i]]]] - cpts[[i]]]; hp = MapThread[HalfSpace, {hns, hpts}]; BoundaryDiscretizeGraphics[#, PlotRange -> bds] & /@ hp, {i, MeshCellCount[dm, 0]}]; AssociationThread[cpts, RegionIntersection @@@ vcells]]; vc = VoronoiCells[pts]; This way we end up with:The whole thing looks like (again using code from Chip Hurst):Regards -- Henrik
Posted 2 months ago
 Addendum:as a first criterion on the "quality" of such a dice might serve the identity of the area of its faces. If we try this with the above, we get: polygs = MeshPrimitives[dice9, 2]; Grid[{Length @@ #, Area[#]} & /@ polygs, Frame -> All] which means that the 4sided faces are probably less likely. This is somewhat disappointing.Somewhere along the post on The Chaos Game by @Sander Huisman differences were found between SpherePoints and a different function (mySpherePoints) based on a simple idea of minimalization. Using this we get: fromSphericalCoordinates[{r_, \[Theta]_, \[Phi]_}] := FromSphericalCoordinates[{r, \[Theta], \[Phi]}]; fromSphericalCoordinates[{1, 0., _}] = {0, 0, 1}; sphereDist[sph1_, sph2_] := EuclideanDistance[fromSphericalCoordinates[Prepend[sph1, 1]], fromSphericalCoordinates[Prepend[sph2, 1]]] mySpherePoints[n_Integer /; n > 2] := Module[{vars, vpairs, energy, constr, sol}, vars = (({Subscript[\[Theta], #1], Subscript[\[Phi], #1]} &) /@ Range[n]); vpairs = Subsets[vars, {2}]; energy = Total[1./Apply[sphereDist, vpairs, {1}]]; constr = Flatten[Apply[{0 <= #1 <= Pi, -Pi <= #2 <= Pi} &, vars, {1}]]; sol = Last[NMinimize[{energy, constr}, constr[[All, 2]]]]; Chop[fromSphericalCoordinates /@ (vars /. sol /. {\[Theta]_, \[Phi]_} :> {1, \[Theta], \[Phi]})]] pts = Append[mySpherePoints[9], {0, 0, 0}]; vc = VoronoiCells[pts]; dice9 = vc[{0., 0., 0.}]; polygs = MeshPrimitives[dice9, 2]; Grid[{Length @@ #, Area[#]} & /@ polygs, Frame -> All] which appears to be somewhat better.
Posted 2 months ago
 A big thank you to everyone especially Henrik Schachner!I realised after posting that an obvious flaw with a 9-sided dice would be that it doesn't have a flat 'top' surface. This isn't really a problem for my sudoku board idea (because the dice would sit in a 'cradle'). Unfortunately, Henrik's great solution uses 4 & 5 sided faces with may not work with the cradle idea.So, I think I'll try to work with a 10 or 12 sided dice. The 12-sided would be the easiest (since I can use a Platonic Solid); but 10 sided is probably doable. :)Once again, my thanks to Henrik.
Posted 2 months ago
 Hi Peter,... yes, a 10sided dice is doable: dice10 = ConvexHullMesh[SpherePoints[7]]; polygs = MeshPrimitives[dice10, 2]; {dice10, Grid[{Length @@ #, Area[#]} & /@ polygs, Frame -> All]} Regards -- Henrik
Posted 2 months ago
 @ HenrikEulerscher Polyedersatz p + f = k + 2 If we ask for f = 9 surfaces and each surface should have 4 edges, but each edge shall belong to two surfaces we arrive at In[17]:= p + f == k + 2 /. k -> 4 f/2 /. f -> 9 Out[17]= 9 + p == 20 p = 11 points. Could you check with Spherepoints (I don't have this function in my Mma 7) if it is possible to connect these 11 points in the desired way?
Posted 2 months ago
 Hello Hans, Could you check with Spherepoints ... using SpherePoints one gets for 11 points:which is not really satisfying! I would very much like to see an improved version of SpherePoints in MM v12 !!! My little routine above gives in this case:which seems to be more like what one expects.But I am afraid your really interesting idea does not work in this case: dice[p_] := dice[p] = ConvexHullMesh[mySpherePoints[p]]; faceNumber[dice_] := Length@MeshPrimitives[dice, 2]; faceNumber[dice[11]] (* Out: 18 *) I guess the reason for this is that the Euler formula holds only in case of triangulation, i.e. if the surface consists of triangles only.Best regards, liebe Gruesse -- Henrik
Posted 2 months ago
 I guess the reason for this is that the Euler formula holds only in case of triangulation, i.e. if the surface consists of triangles only. No, that is generally true. Check e.g. the Platonic body.Proof by induction on p.
Posted 2 months ago
 Yes, you are right! I was fooled by checking the genus of the first of the above example of dices as a central Voronoi cell: genus[dice_] := Module[{faces, edges, points}, faces = Length[MeshPrimitives[dice, 2]]; edges = Length[MeshPrimitives[dice, 1]]; points = Length[MeshPrimitives[dice, 0]]; 1 - (faces - edges + points)/2]; genus[vc[{0., 0., 0.}]] (* Out: -(19/2) *) This means that something else must be wrong here. In the second example (using mySpherePoints) we get 0 for the genus as the correct result.
Posted 2 months ago
 Perhaps this. For each polyhedron p + f = k +2 is correct.But the opposite may false. You can have correct equations but no associated polyhedrons exist.Perhaps one can construct a graph in R2 with eleven points and each point is connected to 3 other points so that a figure consisting of 9 rectangles is obtained?
 G'Day Folks,FYI, I completed the 9-sided "dice" (it isn't a good dice though). :)I found a website with general information about spheres, including lists on coords for "n points on sphere" (http://neilsloane.com/packings/). This gave me 9 (x,y,z) points. I then used Casio's online (x,y,z)->spherical calculator (https://keisan.casio.com/exec/system/1359533867) to convert the points to (lat,long). :)The image below is the dice as viewed in open-scad. The following code is for Open-SCAD; hopefully you'll be able to adapt it to other applications if you need to... long = [0.0000, 3.5638, 41.3251, 93.5638, 145.8026, 183.5638, 221.3251, 273.5638, 325.8026]; lat = [0.0000, 131.8103, 70.5288, 120.0000, 70.5288, 131.8103, 70.5288, 120.0000, 70.5288]; difference() { sphere(10, \$fn=100); for (k=[0:8]) rotate(long[k],[0,0,1]) rotate(lat[k],[1,0,0]) { translate([0,0,13.3]) cube([12,12,10],center=true); translate([-3.75,-4.5,7.805]) linear_extrude(1) text(str(k+1), size=9); } } To understand this code, I suggest looking at something like: for (k=[0:4]) rotate(long[k],[0,0,1]) rotate(lat[k],[1,0,0]) { translate([0,0,13.3]) cube([12,12,10],center=true); translate([-3.75,-4.5,7.805]) linear_extrude(1) text(str(k+1), size=9); } This should give you 5 cubes (and extruded number text) rotated strangely around an empty middle. :)cheers Steve
 An exact way, would be to create something like this: cp = N@CirclePoints[18]; p1 = Append[#, -0.5] & /@ cp; p2 = Append[#, 0.5] & /@ cp; p3 = 2.5 {{0, 0, 1}, {0, 0, -1}}; ConvexHullMesh[Join[p1, p2, p3]] Where the 18 reactangular 'middle' faces are labeled (twice) 1 through 9, in any order you like, but I guess opposite faces same number would be most logical.You can also change it to CirclePoints[9], but then there is no 'top face'…