# How to define logical expressions for platonic solids?

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]


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[#, GrayLevel@.4, "Menu"] &},
PolyhedronData[All]}, {{p, "RegionFunction" (* init *),
"property" // Style[#, GrayLevel@.4, "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 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 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 at 19:19

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 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 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 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 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 at 19:26

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, regFnmesh];
regFnmesh[polyh_] :=
regFnmesh[polyh] =
ConvexHullMesh@PolyhedronData[polyh, "VertexCoordinates"]

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


This looks so cute, though:

regFn["Icosahedron"]


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
*)
`
-
+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.. :( –  Silvia Aug 18 at 19:34
@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. –  Michael E2 Aug 18 at 19:39
Well you can't have a coordsys matching for all of them :) (or can we?) –  Silvia Aug 18 at 19:41
Thanks Michael E2 Despite I can't examine it, it looks good. Time to upgrade to MMA10. –  hieron Aug 18 at 20:04