How to define logical expressions for platonic solids?

Question

A more general question would be: How to find logical expressions for 3D-objects described by closed polygon sets?

Finally a simple question is more prolific, therefore:

How to define logical expressions for platonic solids ?

I study this question for two days now, and I thought, I found an answer already:

PolyhedronData["Tetrahedron", "RegionFunction"]

(* out *)
 Sqrt[2] + 4 Sqrt[3] #3 >= 0 && 
  4 Sqrt[3] #3 <= 3 Sqrt[2] + 8 Sqrt[6] #1 && 
  4 Sqrt[3] (Sqrt[2] #1 + #3) <= 3 Sqrt[2] (1 + 4 #2) && 
  4 (Sqrt[6] #1 + 3 Sqrt[2] #2 + Sqrt[3] #3) <= 3 Sqrt[2] &

So far, so good. But then I discovered ...

PolyhedronData["Octahedron", "RegionFunction"]

Missing["NotAvailable"]

ok, this is not dramatic, I can define this myself. But doing so, I found out, it is better to give up those incomplete and specific RegionFunction definitions of Mathematica. This led me back to my question: How to define region functions for the 5 platonic solids in a better way? What are your ideas, your suggestions? At the moment I just want to concentrate on the platonics.

c = constant = Abs@1; (* -1 <= c <=  +1 *) 
plotPoints = 100/2; (* half value while testing *)

RegionPlot3D[
 And[x + y + z <= c, -x - y + z <= c, 
  x - y - z <= c, -x + y - z <= c, -x - y - z <= c, x + y - z <= c, 
  x - y + z <= c, -x + y + z <= c], {x, -c, c}, {y, -c, c}, {z, -c, 
  c}, PlotPoints -> plotPoints]

octahedronRegionFunction

The octahedron region function could be simplified to: (not sure, if it's really a good idea )

RegionPlot3D[
 Abs@x + Abs@y + Abs@z <= c, {x, -c, +c}, {y, -c, +c}, {z, -c, +c}, 
 PlotPoints -> plotPoints]

two region functions for tetrahedrons of interest

RegionPlot3D[
 And[x + y - z <= c, +x - y + z <= c, -x + y + z <= c, -x - y - z <= 
   c], {x, -c, +c}, {y, -c, +c}, {z, -c, +c}, PlotPoints -> plotPoints]

RegionPlot3D[
 And[x - y - z <= c, -x - y + z <= c, -x + y - z <= c, +x + y + z <= 
   c], {x, -c, +c}, {y, -c, +c}, {z, -c, +c}, PlotPoints -> plotPoints]

What would be `nice` regionFunctions for `Dodecahedron` or `Icosahedron`, to complete the 5 platonics ?

You may checkout yourself the definitions for RegionFunction done by Mathematica. Especially non-convex polyhedrons have no region functions defined. (code from Mathematica, modfied):

Manipulate[
 Column[{PolyhedronData[g], PolyhedronData[g, p]}], {{g, "Octahedron",
    "polyhedron" // Style[#, [email protected], "Menu"] &}, 
  PolyhedronData[All]}, {{p, "RegionFunction" (* init *), 
   "property" // Style[#, [email protected], "Menu"] &}, 
  Complement @@ PolyhedronData /@ {"Properties", "Classes"}}]

These exist in V10 for 151 of the 195 polyhedra in PolyhedronData[], including the Platonic solids. — Michael E2, Aug 18, 2014 at 18:05
nice region functions in V10? Can you kindly post me the output of PolyhedronData["Octahedron","RegionFunction"] in an answer? — hieron, Aug 18, 2014 at 18:10
You can make it shorter with ContourPlot3D[Norm[{x,y,z},1]==1,{x,-1,1},{y,-1,1},{z,-1,1}]. — Silvia, Aug 18, 2014 at 19:19

Michael E2 · Accepted Answer · 2014-08-18 18:16:24Z

I suppose they are nice....They check that a point is inside each facet plane.

# -> PolyhedronData[#, "RegionFunction"] & /@ {"Octahedron", 
  "Dodecahedron", "Icosahedron"}
(*
{"Octahedron" -> (2 (#1 + #3) <= Sqrt[2] + 2 #2 && 
     2 (#1 + #2 + #3) <= Sqrt[2] && 2 (#2 + #3) <= Sqrt[2] + 2 #1 && 
     2 #3 <= Sqrt[2] + 2 #1 + 2 #2 && 
     Sqrt[2] + 2 #1 + 2 #2 + 2 #3 >= 0 && 
     2 #1 <= Sqrt[2] + 2 #2 + 2 #3 && 2 #2 <= Sqrt[2] + 2 #1 + 2 #3 &&
      2 (#1 + #2) <= Sqrt[2] + 2 #3 &), 
 "Dodecahedron" -> (5 (2 + Sqrt[5]) + 
       Sqrt[10 (5 + Sqrt[5])] (2 #1 + #3) >= 0 && 
     Sqrt[10 (5 + Sqrt[5])] (2 #1 + #3) <= 5 (2 + Sqrt[5]) && 
     Sqrt[50 - 10 Sqrt[5]] #1 + Sqrt[10 (5 + Sqrt[5])] #3 <= 
      5 (2 + Sqrt[5] + (1 + Sqrt[5]) #2) && 
     Sqrt[2 (5 + Sqrt[5])] #3 <= 2 + Sqrt[5] && 
     Sqrt[50 - 10 Sqrt[5]] #1 + 5 (1 + Sqrt[5]) #2 + 
       Sqrt[10 (5 + Sqrt[5])] #3 <= 5 (2 + Sqrt[5]) && 
     2 Sqrt[5 (5 + 2 Sqrt[5])] #1 + 10 #2 <= 
      5 (2 + Sqrt[5]) + Sqrt[10 (5 + Sqrt[5])] #3 && 
     2 Sqrt[5 (5 + 2 Sqrt[5])] #1 <= 
      5 (2 + Sqrt[5]) + 10 #2 + Sqrt[10 (5 + Sqrt[5])] #3 && 
     5 (1 + Sqrt[5]) #2 <= 
      5 (2 + Sqrt[5]) + Sqrt[50 - 10 Sqrt[5]] #1 + 
       Sqrt[10 (5 + Sqrt[5])] #3 && 
     Sqrt[5/8 + 11/(8 Sqrt[5])] + #3 >= 0 && 
     5 (2 + Sqrt[5]) + Sqrt[50 - 10 Sqrt[5]] #1 + 5 (1 + Sqrt[5]) #2 +
        Sqrt[10 (5 + Sqrt[5])] #3 >= 0 && 
     Sqrt[10 (5 + Sqrt[5])] #3 <= 
      2 Sqrt[5 (5 + 2 Sqrt[5])] #1 + 5 (2 + Sqrt[5] + 2 #2) && 
     10 #2 + Sqrt[10 (5 + Sqrt[5])] #3 <= 
      5 (2 + Sqrt[5]) + 2 Sqrt[5 (5 + 2 Sqrt[5])] #1 &), 
 "Icosahedron" -> (30 #1 + 2 Sqrt[250 - 110 Sqrt[5]] #2 + 10 #3 <= 
      Sqrt[5] (Sqrt[10 - 2 Sqrt[5]] + 14 #1 + 2 #3) && 
     2 Sqrt[2] ((-3 + Sqrt[5]) #1 + #3) <= Sqrt[5 + Sqrt[5]] && 
     10 (3 #1 + #3) <= 
      Sqrt[5] (Sqrt[10 - 2 Sqrt[5]] + 14 #1 + 
         2 Sqrt[50 - 22 Sqrt[5]] #2 + 2 #3) && 
     2 (Sqrt[10 - 4 Sqrt[5]] #1 + Sqrt[2] (-5 + 2 Sqrt[5]) #2 + 
         Sqrt[5 - Sqrt[5]] #3) <= Sqrt[10] && 
     2 (Sqrt[10 - 4 Sqrt[5]] #1 + Sqrt[2] (5 - 2 Sqrt[5]) #2 + 
         Sqrt[5 - Sqrt[5]] #3) <= Sqrt[10] && 
     2 Sqrt[5] (7 #1 + #3) <= 
      Sqrt[50 - 10 Sqrt[5]] + 30 #1 + 2 Sqrt[250 - 110 Sqrt[5]] #2 + 
       10 #3 && 
     Sqrt[5 + Sqrt[5]] + 2 Sqrt[2] (-3 + Sqrt[5]) #1 + 2 Sqrt[2] #3 >=
       0 && 2 Sqrt[5] (7 #1 + Sqrt[50 - 22 Sqrt[5]] #2 + #3) <= 
      Sqrt[50 - 10 Sqrt[5]] + 30 #1 + 
       10 #3 && (-3 + Sqrt[5]) Sqrt[5 + Sqrt[5]] #1 + 
       2 Sqrt[2] (5 - 2 Sqrt[5]) #2 <= 
      Sqrt[10] + 
       2 Sqrt[5 - Sqrt[5]] #3 && (-3 + Sqrt[5]) Sqrt[
        5 + Sqrt[5]] #1 + 2 Sqrt[2] (-5 + 2 Sqrt[5]) #2 <= 
      Sqrt[10] + 2 Sqrt[5 - Sqrt[5]] #3 && 
     2 Sqrt[5] (4 #1 + 2 Sqrt[5 - 2 Sqrt[5]] #2 + 7 #3) <= 
      Sqrt[50 - 10 Sqrt[5]] + 20 #1 + 30 #3 && 
     2 Sqrt[2] ((-5 + Sqrt[5]) #1 + (5 - 2 Sqrt[5]) #3) <= Sqrt[
      5 (5 + Sqrt[5])] && 
     2 Sqrt[5] (4 #1 + 7 #3) <= 
      Sqrt[50 - 10 Sqrt[5]] + 20 #1 + 4 Sqrt[5 (5 - 2 Sqrt[5])] #2 + 
       30 #3 && 
     2 (-15 + 7 Sqrt[5]) #3 <= 
      Sqrt[50 - 10 Sqrt[5]] + 2 (-5 + Sqrt[5]) #1 + 
       2 Sqrt[250 - 110 Sqrt[5]] #2 && 
     2 Sqrt[250 - 110 Sqrt[5]] #2 + 2 (-15 + 7 Sqrt[5]) #3 <= 
      Sqrt[50 - 10 Sqrt[5]] + 2 (-5 + Sqrt[5]) #1 && 
     20 #1 + 30 #3 <= 
      Sqrt[5] (Sqrt[10 - 2 Sqrt[5]] + 8 #1 + 
         4 Sqrt[5 - 2 Sqrt[5]] #2 + 14 #3) && 
     2 Sqrt[2] (-5 + 2 Sqrt[5]) #3 <= 
      Sqrt[5 (5 + Sqrt[5])] + 2 Sqrt[2] (-5 + Sqrt[5]) #1 && 
     20 #1 + 4 Sqrt[5 (5 - 2 Sqrt[5])] #2 + 30 #3 <= 
      Sqrt[5] (Sqrt[10 - 2 Sqrt[5]] + 8 #1 + 14 #3) && 
     2 (-5 + Sqrt[5]) #1 + 2 Sqrt[250 - 110 Sqrt[5]] #2 + 
       2 (15 - 7 Sqrt[5]) #3 <= Sqrt[50 - 10 Sqrt[5]] && 
     2 (-5 + Sqrt[5]) #1 + 2 (15 - 7 Sqrt[5]) #3 <= 
      Sqrt[50 - 10 Sqrt[5]] + 2 Sqrt[250 - 110 Sqrt[5]] #2 &)}
*)

Thanks (+), for delivery. At the same time it illustrates the problem. — hieron, Aug 18, 2014 at 18:21
Yes, too long, it could be done more dense. Honestly, would you like to work with those 2 pages of logical expressions. Of course, content is ok, but the presentation is not! — hieron, Aug 18, 2014 at 18:27
@hieron I would let Mathematica work with them. I doubt it would complain. :) If this is about pencil & paper work, how is it a Q about Mathematica? If not, it seems like a mathematics question. — Michael E2, Aug 18, 2014 at 18:36
In my mind the quality of the built-in functions is rather high. $n$ linear inequalities, one for each face. Just my opinion, though. Well, let's see if someone can improve. :) — Michael E2, Aug 18, 2014 at 18:55
@hieron OK the microscope thing reminds me, maybe there are simple 3D cellular automata rules generating these polyhedrons. But I think the formulae provided by PolyhedronData[..., "RegionFunction"] are not optimized for insightful concept but for numerical computing. If you are looking for the former one, you might want to emphasize it in you question. — Silvia, Aug 18, 2014 at 19:26

Michael E2 · Accepted Answer · 2014-08-18 19:26:29Z

2

Here is a different sort of answer, but very V10-style. The only logical expression however is Element, so I'm afraid this will fall short.

Clear[regFn, regFn`mesh]; 
regFn`mesh[polyh_] := 
 regFn`mesh[polyh] = 
  ConvexHullMesh@PolyhedronData[polyh, "VertexCoordinates"]

regFn[polyh_] := 
 With[{region = regFn`mesh[polyh]}, {##} ∈ region &]

This looks so cute, though:

regFn["Icosahedron"]

Mathematica graphics

regFn["Icosahedron"][1/2, 1/2, 1/2]
regFn["Icosahedron"][1/3, 1/3, 1/3]
(*
  False
  True
*)

This function is almost as fast as the compiled PolyhedronData region function:

Needs["GeneralUtilities`"];

rf1 = regFn["Icosahedron"];
rf2 = PolyhedronData["Icosahedron", "RegionFunction"];
rf2C = Compile @@ {{x, y, z}, 
    PolyhedronData["Icosahedron", "RegionFunction"][x, y, z]};

rf1[1/2, 1/2, 1/2] // AccurateTiming
rf2[1/2, 1/2, 1/2] // AccurateTiming
rf2C[1/2, 1/2, 1/2] // AccurateTiming
(*
  9.6709*10^-6
  0.000285342
  5.22754*10^-6
 *)

answered Aug 18, 2014 at 19:26

Michael E2

233k16 gold badges328 silver badges733 bronze badges

1

$\begingroup$ +1 for demonstrating the new features in v10. But I guess what OP wants are some mathematical insight, beautiful in concept representations. I'm thinking about something starting from the crystallographic point groups, but I've forgotten my group theory knowledge.. :( $\endgroup$
– Silvia
Aug 18, 2014 at 19:34
1

$\begingroup$ @Silvia Coxeter's book Regular Polytopes might have nice formulas. I don't have it handy, though. The problem, IMO, is that the symmetry of dodeca/icosahedra do not match the symmetry of the xyz coordinate system. $\endgroup$
– Michael E2
Aug 18, 2014 at 19:39
$\begingroup$ Well you can't have a coordsys matching for all of them :) (or can we?) $\endgroup$
– Silvia
Aug 18, 2014 at 19:41
$\begingroup$ Thanks Michael E2 Despite I can't examine it, it looks good. Time to upgrade to MMA10. $\endgroup$
– hieron
Aug 18, 2014 at 20:04

Add a comment |

Stack Exchange Network

How to define logical expressions for platonic solids?