Circumsphere

Author

Eric W. Weisstein
June 15, 2023

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

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

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

Platonics

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

Computation

(m=Join[{{x^2+y^2+z^2,x,y,z,1}},Table[{x[i]^2+y[i]^2+z[i]^2,x[i],y[i],z[i],1},{i,4}]
])//MatrixForm

(a=Transpose[Rest[Transpose[Rest[m]]]])//MatrixForm

Equal@@Prepend[Det[m2],Coefficient[Expand[Det[m]],#^2]&/@{x,y,z}]

Coefficient[Expand[Det[m]],#]&/@{x y,x z,y z}

l=Coefficient[Expand[Det[m]],#]&/@{x ,y,z};

SameQ@@l

MatrixForm/@(ds=Table[Transpose[Drop[Transpose[Rest[m]],{i+1}]],{i,3}])

(c=Transpose[Drop[Transpose[Rest[m]],-1]])//MatrixForm

Expand[Subtract@@{Det[m],Det[a](x^2+y^2+z^2)-(Det/@ds).{x,-y,z}+Det[c]}]

CircumsphereMatrix[l_List,{xx_,yy_,zz_}]:=Module[{i},
Join[{{xx^2+yy^2+zz^2,xx,yy,zz,1}},Table[{x[i]^2+y[i]^2+z[i]^2,x[i],y[i],z[i],1},{i,4}]]/.Flatten[Table[Thread[{x[i],y[i],z[i]}->l[[i]]],{i,4}]]
]

CircumsphereMatrix[Table[{x[i],y[i],z[i]},{i,4}],{x,y,z}]//MatrixForm

CircumsphereConstants[l_List]:=Module[
{
m=Rest[CircumsphereMatrix[l,{xx,yy,zz}]],
i
},
{
Det[Transpose[Rest[Transpose[m]]]],
Table[(-1)^(i+1) Det[Transpose[Drop[Transpose[m],{i+1}]]],{i,3}],
Det[Transpose[Drop[Transpose[m],-1]]]
}
]

Plot

pts3=Table[Random[],{4},{3}]

pts3={{0.7362877395396943`,0.8580444167160272`,0.9822710233215991`},{0.18993989996052066`,0.8297368829285517`,0.5740899750110539`},{0.9032400161604422`,0.1929765576118006`,0.8990363948343676`},{0.29833030943589395`,0.4504287221402965`,0.9350961411009943`}};

Show[Graphics3D[{
{RGBColor[1,0,0],PointSize[.04],Point/@pts3},
Wireframe@Circumsphere[pts3]
}],PlotRange->All,Boxed->False]

Show[GraphicsArray[Partition[Table[Graphics3D[{
{RGBColor[1,0,0],PointSize[.05],Point/@#},
Wireframe@Circumsphere[#]
},PlotRange->All,Boxed->False]&[Table[Random[],{4},{3}]],{12}],4]],
GraphicsSpacing->-.2]

Solids

Wireframe

Show[GraphicsArray[Graphics3D[{Wireframe[Sphere[Circumradius[#]]],Polyhedron[#]},Boxed->False]&/@Platonics
],GraphicsSpacing->-.2,ImageSize->450]

Opacity and circles

PolyhedronData["GyrateRhombicosidodecahedron","Circumsphere"]

CircumsphereDiagram["Cube"]

CircumsphereDiagram["GyrateRhombicosidodecahedron",20]

CircumsphereDiagram/@PolyhedronData["Platonic"]

CircumsphereDiagram/@PolyhedronData["Archimedean"]

CircumsphereDiagram/@PolyhedronData["KeplerPoinsot"]

CircumsphereDiagram/@PolyhedronData["Prism"]

circ=Select[PolyhedronData[All],!MissingQ[PolyhedronData[#,"Circumsphere"]]&]

Print[Rule[#,CircumsphereDiagram[#]]]&/@circ;