Insphere

Author

Eric W. Weisstein
June 15, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SolidGeometry/Insphere.nb.

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

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

Platonics

GraphicsRow[Graphics3D[{Opacity[0.5],{Yellow,PolyhedronData[#,"Faces"]},{Red,PolyhedronData[#,"Insphere"]}},Boxed->False,Method->{"ShrinkWrap"->True}]&/@PolyhedronData["Platonic"],Dividers->All]

Archimedean Dual

GraphicsGrid[Partition[Graphics3D[{Opacity[0.5],{Yellow,PolyhedronData[#,"Faces"]},{Red,PolyhedronData[#,"Insphere"]}},Boxed->False,Method->{"ShrinkWrap"->True}]&/@PolyhedronData["ArchimedeanDual"],UpTo[5]],Dividers->All]

Solids

"Cube"

bug((HyperlinkTemplate[393519, https://bugs.wolfram.com/show?number=393519None, https://bugs.wolfram.com/show?number=393519, HyperlinkActionRecycled, HyperlinkActive, , ])): RegionIntersection[sphere, poly] should evaluate

(s=MyInsphere[p=PolyhedronData["Cube","Polyhedron"]])//Timing

sphere=Sphere[{0,0,0},1];
poly=Polygon[{{0,0,1},{1,0,1},{0,1,1}}];

RegionIntersection[sphere,poly]

RegionMember[#,{0,0,1}]&/@{sphere,poly}

PolyhedronInequalities[Polyhedron[{{0,0,1},{1,0,1},{0,1,1}},{{1,2,3}}],{x,y,z}]

Entity["Lamina","FilledRightTriangle"]["Inequalities"][1,1][x,y]

Reduce[x^2+y^2+z^2==1&&y≥0&&1≥x+y&&x≥0&&z==1,{x,y,z}]

RegionIntersection[s,#]&/@PolyhedronData["Cube","Polygons"]//Union

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData["Cube","Polyhedron"]}]

"EquilateralAugmentedCube"

bug((HyperlinkTemplate[393061, https://bugs.wolfram.com/show?number=393061None, https://bugs.wolfram.com/show?number=393061, HyperlinkActionRecycled, HyperlinkActive, , ])): Refine or clarify ref/Insphere statement "Insphere[poly] returns a sphere that is contained within the polyhedron poly and tangent to each of the polyhedron faces."

bug((HyperlinkTemplate[393519, https://bugs.wolfram.com/show?number=393519None, https://bugs.wolfram.com/show?number=393519, HyperlinkActionRecycled, HyperlinkActive, , ])): RegionIntersection[sphere, poly] should evaluate

s=Insphere[p=PolyhedronData["EquilateralAugmentedCube","Polyhedron"]]

RegionIntersection[s,p]

RegionIntersection[s,#]&/@PolyhedronData["EquilateralAugmentedCube","Polygons"]//Union

(s=MyInsphere[p=PolyhedronData["EquilateralAugmentedCube","Polyhedron"]])//Timing

Subtract@@{(Sqrt[(1/4)+(1/(3 (Sqrt[2])))]),(1/6) ((Sqrt[3])+(Sqrt[6]))}//FullSimplify

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData["EquilateralAugmentedCube","Polyhedron"]}]

{"Pyramid", 4}

(s=MyInsphere[p=PolyhedronData[{"Pyramid",4},"Polyhedron"]])//Timing

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData[{"Pyramid",4},"Polyhedron"]}]

s=Insphere[p]

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData[{"Pyramid",4},"Polyhedron"]}]

{"Pyramid", 5}

MyInsphere[(p=PolyhedronData[{"Pyramid",5},"Polyhedron"])//N]

Insphere[p]//FullSimplify

(s=MyInsphere[p=PolyhedronData[{"Pyramid",5},"Polyhedron"],"Simplification"->FullSimplify,Debug->True])//Timing

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData[{"Pyramid",5},"Polyhedron"]}]

s=Insphere[p]

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData[{"Pyramid",5},"Polyhedron"]}]

{"RhombicDodecahedronStellation", 3}

PolyhedronData[{"RhombicDodecahedronStellation",3},"Insphere"]

Insphere[p]//Quiet

Insphere[p//N]//Quiet

s=MyInsphere[p]

Graphics3D[{Red,s,Opacity[.4],Yellow,p}]

"Tetrahedron"

(s=MyInsphere[p=PolyhedronData["Tetrahedron","Polyhedron"]])//Timing

Insphere[p]

Graphics3D[{Red,s,Opacity[.4],Yellow,p=PolyhedronData["Tetrahedron","Polyhedron"]}]