Golden Rhombohedron

Author

Eric W. Weisstein
December 27, 2009

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/GoldenRhombohedron.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/GoldenRhombohedron.html.

©2009 Wolfram Research, Inc. except for portions noted otherwise

Graphics

V5

Show[Graphics3D[GoldenRhombohedron],Boxed->False]

V8

PolyhedronData["Rhombohedron"]

PolyhedronData["*GoldenRhombohedron"]

PolyhedronData/@%

LiveGraphics3D

<<Utilities`LiveGraphics3D`

WriteLiveForm["goldenrh.m",Show[Graphics3D[GoldenRhombohedron],Boxed->False]]

Properties

gr=PolyhedronData["*GoldenRhom*"]

Surface Area

PolyhedronData[#,"SurfaceArea"]&/@gr

Volume

PolyhedronData[#,"Volume"]&/@gr

ToRadicals/@%//Simplify

Centroid

PolyhedronData[#,"Centroid"]&/@gr

Inertia Tensor

TraditionalForm/@(Simplify/@ToRadicals/@(PolyhedronData[#,"InertiaTensor"]&/@gr))//TraditionalForm

Vertex Subset Hulls

Acute

p="AcuteGoldenRhombohedron";

(h=VertexSubsetHulls[p,"Platonic","Skip"->{}])//Timing

Obtuse

p="ObtuseGoldenRhombohedron";

(h=VertexSubsetHulls[p,"Platonic","Skip"->{}])//Timing

Construction

Simplify[Polyhedron[Rhombohedron[{a,b}]],a>0&&b>0]

Acute

Solve[{a^2+b^2==1,((((((Sqrt[(a^2)+(b^2)])+a))^2)+b^2)/(((((Sqrt[(a^2)+(b^2)])-a))^2)+b^2))==GoldenRatio^2},{a,b}]

Graphics3D[p=Polyhedron[Rhombohedron[{1,2}/(Sqrt[5])]]]

Length[v=PolyhedronVertices[p]]

p/.Polygon[{x1_,x2_,x3_,x4_}]:>Norm[x1-x3]/Norm[x2-x4]//FullSimplify//Union

PolyhedronFaces[p]

Graphics3D[{p,Point[v],MapIndexed[Text[#2[[1]],#+.03{1,1,0},Background->White]&,v]}]

CoplanarQ[v[[{1,3,5,4}]]]

((Norm[Subtract@@v[[{1,5}]]])/(Norm[Subtract@@v[[{3,4}]]]))//FullSimplify

OrientedQ[p,Mean[v[[#]]]]&/@{{4,8},{5,7},{1,6},{2,3}}

Obtuse

Solve[{a^2+b^2==1,((((((Sqrt[(a^2)+(b^2)])+a))^2)+b^2)/(((((Sqrt[(a^2)+(b^2)])-a))^2)+b^2))==1/GoldenRatio^2},{a,b}]

Graphics3D[p=Polyhedron[Rhombohedron[{-1,2}/(Sqrt[5])]]]

Length[v=PolyhedronVertices[p]]

p/.Polygon[{x1_,x2_,x3_,x4_}]:>Norm[x1-x3]/Norm[x2-x4]//FullSimplify//Union

Graphics3D[{FaceForm[Glow/@{Red,Blue}],p,Point[v],MapIndexed[Text[#2[[1]],#+.03{1,1,0},Background->White]&,v]},Lighting->None]

Mean[v[[#]]]&/@{{4,8},{5,7},{1,6},{2,3}}//FullSimplify

CoplanarQ[v[[{1,5,3,4}]]]

Norm[Subtract@@v[[{5,4}]]]/Norm[Subtract@@v[[{1,3}]]]//FullSimplify

OrientedQ[p,Mean[v[[#]]]]&/@{{4,8},{5,7},{1,6},{2,3}}

PolyhedronData

PolyhedronData["Classes"]

PolyhedronDataString[Polyhedron[Rhombohedron[{1,2}/(Sqrt[5])]]/.Polygon[p_]:>Polygon[#-{1/2+1/Sqrt[5],(5+3Sqrt[5])/20,Sqrt[1/8+1/(8Sqrt[5])]}&/@p],
"Name" -> "acute golden rhombohedron",
"StandardName"->"AcuteGoldenRhombohedron",
"Classes"->{"Convex","Rhombohedron","SpaceFilling","Zonohedron"},
Debug->True
]

PolyhedronDataString[Polyhedron[Rhombohedron[{-1,2}/(Sqrt[5])]]/.Polygon[p_]:>Polygon[#-{1/2-1/Sqrt[5],(-5+3Sqrt[5])/20,Root[1-20#1^2+80#1^4&,3,0]}&/@p],
"Name" -> "obtuse golden rhombohedron",
"StandardName"->"ObtuseGoldenRhombohedron",
"Classes"->{"Convex","Rhombohedron","SpaceFilling","Zonohedron"},
Debug->True
]