2
$\begingroup$

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"}}]
Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ These exist in V10 for 151 of the 195 polyhedra in PolyhedronData[], including the Platonic solids. $\endgroup$
    – Michael E2
    Aug 18, 2014 at 18:05
  • $\begingroup$ nice region functions in V10? Can you kindly post me the output of PolyhedronData["Octahedron","RegionFunction"] in an answer? $\endgroup$
    – hieron
    Aug 18, 2014 at 18:10
  • 2
    $\begingroup$ You can make it shorter with ContourPlot3D[Norm[{x,y,z},1]==1,{x,-1,1},{y,-1,1},{z,-1,1}]. $\endgroup$
    – Silvia
    Aug 18, 2014 at 19:19

2 Answers 2

Reset to default
3
$\begingroup$

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 &)}
*)
Improve this answer
$\endgroup$
10
  • $\begingroup$ Thanks (+), for delivery. At the same time it illustrates the problem. $\endgroup$
    – hieron
    Aug 18, 2014 at 18:21
  • $\begingroup$ 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! $\endgroup$
    – hieron
    Aug 18, 2014 at 18:27
  • 1
    $\begingroup$ @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. $\endgroup$
    – Michael E2
    Aug 18, 2014 at 18:36
  • 1
    $\begingroup$ 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. :) $\endgroup$
    – Michael E2
    Aug 18, 2014 at 18:55
  • 1
    $\begingroup$ @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. $\endgroup$
    – Silvia
    Aug 18, 2014 at 19:26
2
$\begingroup$

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
 *)
Improve this answer
$\endgroup$
4
  • 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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.