Message Boards Message Boards

GROUPS:

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

Here comes a first guess:

enter image description here

Hi Henrik,

This has 14 faces though…

MeshPrimitives[ConvexHullMesh[SpherePoints[9]], 2] // Length

not the requested 9…

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:

enter image description here

The whole thing looks like (again using code from Chip Hurst):

enter image description here

Regards -- Henrik

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]

enter image description here

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]

enter image description here

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.

Hi Peter,

... yes, a 10sided dice is doable:

dice10 = ConvexHullMesh[SpherePoints[7]];
polygs = MeshPrimitives[dice10, 2];
{dice10, Grid[{Length @@ #, Area[#]} & /@ polygs, Frame -> All]}

enter image description here

Regards -- Henrik

@ Henrik

Eulerscher 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?

Hello Hans,

Could you check with Spherepoints ...

using SpherePoints one gets for 11 points:

enter image description here

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:

enter image description here

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.

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.

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?

Posted 2 months ago

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. 9-sided dice

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]]

enter image description here

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'…

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract