Disphenocingulum

Author

Eric W. Weisstein
May 31, 2020

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

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

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

To do

Simplify combinations of Root objects in RegionFunction

Graphic

PolyhedronData["Disphenocingulum","StandardNames"]

PolyhedronData

PolyhedronData["Disphenocingulum"]

PolyhedronData["Disphenocingulum","VertexCoordinates"]

PolyhedronData (V12.1)

PolyhedronData["Disphenocingulum","StandardNames"]

PolyhedronData["Disphenocingulum"]

Netlib (inexact, weird orienation)

PolyhedronName[JohnsonSolid[90]]

Show[Graphics3D[Polyhedron[JohnsonSolid[90]]],Boxed->False]

Net

PolyhedronData

PolyhedronData["Disphenocingulum","Net"]

PolyhedronData["Disphenocingulum","Net","Colored"]

Netlib

Show[Graphics[Net[JohnsonSolid[90]]],AspectRatio->Automatic]

Properties

p=PolyhedronData[pname="Disphenocingulum","Polyhedron"]

punsimplfied=Polyhedron[];

PolyhedronCoordinates[unsimplfiedp]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Length[%]

Centroid

PolyhedronData["Disphenocingulum","Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

sphere=MyCircumsphere[p]

Convex

ConvexPolyhedronQ[p]

DihedralAngles

d=PolyhedronData["Disphenocingulum","DihedralAngles"]

Union[d]

<<MathWorld`PolyhedronOperations`

dih=DihedralAngles[p];

N[d-dih,1000]//Abs//Max

d/.{d[[1]]->term1,d[[7]]->term7,d[[9]]->term9,d[[21]]->term21}

2

res=DihedralAngles[p][[2]]

ByteCount[res]

res//N

expr1=Cos[res];

expr2=RootApproximant[N[expr1,150],24]

N[expr1-expr2,1000]

N[expr1,300]

N[expr2,300]

%-%%

d/. 2.59066`->ArcCos[(NumericalApproximation[Root, (RowDefault["-0.852", FEExpressionsNumericalApproximationElider]), Root[-20855+7124 #1+129922 ((#1)^2)-79388 ((#1)^3)-277201 ((#1)^4)+238728 ((#1)^5)+209340 ((#1)^6)-262008 ((#1)^7)-5913 ((#1)^8)+96228 ((#1)^9)-33534 ((#1)^10)-8748 ((#1)^11)+6561 ((#1)^12)&,3], ])]

Union[%]

roots=Cases[res,_Root,∞]//Union

nroots=Length[roots]

vars=Array[a,nroots]

FullSimplify[Cos[res]^2/.Thread[roots->vars],Element[vars,Reals]]

simp=FullSimplify[%/.Thread[vars->roots]]

N[%]

Cos[res]^2//N

term2=ArcCos[-Sqrt[simp]]//FullSimplify

N[term2-res,50]

2 (unsimplified)

res=DihedralAngles[punsimplfied][[2]]

N[%]

ByteCount[res]

roots=Cases[res,_Root,∞]//Union

{(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])}

nroots=Length[roots]

vars=Array[a,nroots]

FullSimplify[Cos[res]/.Thread[roots->vars],Element[vars,Reals]&&0<a[1]<1]

FullSimplify[Cos[res]/.Thread[roots->vars],Element[vars,Reals]&&1/2<a[1]<1]

res2=FullSimplify[Cos[res]/.Thread[roots->vars],Element[vars,Reals]&&76/100<a[1]<77/100]

ArcCos[res2/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//N

res2/.((((1-2 a[1]))^2) ((((Sqrt[3-4 ((a[1])^2)])-2 a[1] (Sqrt[1-((a[1])^2)])))^2)+(((-1+2 a[1] (1+a[1]-2 ((a[1])^2))+(Sqrt[2]) (Sqrt[(-1+4 (-1+a[1]) a[1]) (-3+4 ((a[1])^2))])))^2)+(((1-2 ((a[1])^2)+4 ((a[1])^3)-2 a[1] (1+(Sqrt[2+8 a[1]-10 ((a[1])^2)-8 ((a[1])^3)+8 ((a[1])^4)]))))^2))->expr

Ran overnight:

FullSimplify[res2/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

FullSimplify[((((1-2 a[1]))^2) ((((Sqrt[3-4 ((a[1])^2)])-2 a[1] (Sqrt[1-((a[1])^2)])))^2)+(((-1+2 a[1] (1+a[1]-2 ((a[1])^2))+(Sqrt[2]) (Sqrt[(-1+4 (-1+a[1]) a[1]) (-3+4 ((a[1])^2))])))^2)+(((1-2 ((a[1])^2)+4 ((a[1])^3)-2 a[1] (1+(Sqrt[2+8 a[1]-10 ((a[1])^2)-8 ((a[1])^3)+8 ((a[1])^4)]))))^2))/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

RootReduce[(((1-2 a[1]))^2) ((((Sqrt[3-4 ((a[1])^2)])-2 a[1] (Sqrt[1-((a[1])^2)])))^2)/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

FullSimplify[((Sqrt[3-4 ((a[1])^2)])-2 a[1] (Sqrt[1-((a[1])^2)]))/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

FullSimplify[-1+2 (-1+a[1]) a[1] (1+2 a[1])-(Sqrt[2]) (Sqrt[(-1+4 (-1+a[1]) a[1]) (-3+4 ((a[1])^2))])/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

FullSimplify[(((1-2 ((a[1])^2)+4 ((a[1])^3)-2 a[1] (1+(Sqrt[2+8 a[1]-10 ((a[1])^2)-8 ((a[1])^3)+8 ((a[1])^4)]))))^2)/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

FullSimplify[a[1] (1-2 ((a[1])^2)+4 ((a[1])^3)-2 a[1] (1+(Sqrt[2+8 a[1]-10 ((a[1])^2)-8 ((a[1])^3)+8 ((a[1])^4)])))/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])]//Timing

FullSimplify[

ArcCos[(1/(Sqrt[3]))(((1+2 (-1+a[1]) a[1] (1+2 a[1])-(Sqrt[2]) (Sqrt[(-1+4 (-1+a[1]) a[1]) (-3+4 ((a[1])^2))]))/(Sqrt[(((1/4) ((NumericalApproximation[Root, (RowDefault["-3.46", FEExpressionsNumericalApproximationElider]), Root[2188115968-490995712 #1-628031488 ((#1)^2)+149061632 ((#1)^3)+52490240 ((#1)^4)-13314048 ((#1)^5)-830464 ((#1)^6)+248064 ((#1)^7)-28272 ((#1)^8)+9696 ((#1)^9)-712 ((#1)^10)-24 ((#1)^11)+((#1)^12)&,3], ])^2) (1-((a[1])^2)))/(3-7 ((a[1])^2)+4 ((a[1])^4)))]))+a[1] (-1+2 a[1]) (Sqrt[((3-4 ((a[1])^2))/((1/4) ((NumericalApproximation[Root, (RowDefault["-3.46", FEExpressionsNumericalApproximationElider]), Root[2188115968-490995712 #1-628031488 ((#1)^2)+149061632 ((#1)^3)+52490240 ((#1)^4)-13314048 ((#1)^5)-830464 ((#1)^6)+248064 ((#1)^7)-28272 ((#1)^8)+9696 ((#1)^9)-712 ((#1)^10)-24 ((#1)^11)+((#1)^12)&,3], ])^2)))]) (-2 a[1]+(Sqrt[((-3+4 ((a[1])^2))/(-1+((a[1])^2)))]))+((a[1] (1-2 ((a[1])^2)+4 ((a[1])^3)-2 a[1] (1+(Sqrt[2+8 a[1]-10 ((a[1])^2)-8 ((a[1])^3)+8 ((a[1])^4)]))))/(Sqrt[(1/4) ((NumericalApproximation[Root, (RowDefault["-3.46", FEExpressionsNumericalApproximationElider]), Root[2188115968-490995712 #1-628031488 ((#1)^2)+149061632 ((#1)^3)+52490240 ((#1)^4)-13314048 ((#1)^5)-830464 ((#1)^6)+248064 ((#1)^7)-28272 ((#1)^8)+9696 ((#1)^9)-712 ((#1)^10)-24 ((#1)^11)+((#1)^12)&,3], ])^2) (1-((a[1])^2))])))]/.a[1]->(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])//N

6

res=DihedralAngles[p][[6]]

ByteCount[res]

res//N

N[expr1=Cos[res]]

expr2=RootApproximant[N[expr1,200],24]

N[expr1-expr2,1000]

ArcCos@(NumericalApproximation[Root, (RowDefault["-0.690", FEExpressionsNumericalApproximationElider]), Root[-39815-495596 #1-653438 ((#1)^2)+1878564 ((#1)^3)+4074471 ((#1)^4)-522072 ((#1)^5)-5492772 ((#1)^6)-1246104 ((#1)^7)+3206871 ((#1)^8)+726084 ((#1)^9)-826686 ((#1)^10)-78732 ((#1)^11)+59049 ((#1)^12)&,4], ])//N

d/. 2.33161`->ArcCos@(NumericalApproximation[Root, (RowDefault["-0.690", FEExpressionsNumericalApproximationElider]), Root[-39815-495596 #1-653438 ((#1)^2)+1878564 ((#1)^3)+4074471 ((#1)^4)-522072 ((#1)^5)-5492772 ((#1)^6)-1246104 ((#1)^7)+3206871 ((#1)^8)+726084 ((#1)^9)-826686 ((#1)^10)-78732 ((#1)^11)+59049 ((#1)^12)&,4], ])

Union[%]

8

res=DihedralAngles[p][[8]]

ByteCount[res]

res//N

N[expr1=Cos[res]]

expr2=RootApproximant[N[expr1,500],24]

N[expr1-expr2,3000]

FullSimplify[expr1-expr2]

N[expr1,20]

N[expr2,20]

ArcCos[(NumericalApproximation[Root, (RowDefault["-0.902", FEExpressionsNumericalApproximationElider]), Root[12633595858129-102010884561792 ((#1)^2)+2926005117403248 ((#1)^4)-34188564569482944 ((#1)^6)+142294272721388640 ((#1)^8)-292618531512025344 ((#1)^10)+336405217341259008 ((#1)^12)-225204354450994176 ((#1)^14)+88020632130289920 ((#1)^16)-20265400532643840 ((#1)^18)+2970831415173120 ((#1)^20)-258532084482048 ((#1)^22)+7836416409600 ((#1)^24)&,6], ])]//N

d/.N[ArcCos[(NumericalApproximation[Root, (RowDefault["-0.902", FEExpressionsNumericalApproximationElider]), Root[12633595858129-102010884561792 ((#1)^2)+2926005117403248 ((#1)^4)-34188564569482944 ((#1)^6)+142294272721388640 ((#1)^8)-292618531512025344 ((#1)^10)+336405217341259008 ((#1)^12)-225204354450994176 ((#1)^14)+88020632130289920 ((#1)^16)-20265400532643840 ((#1)^18)+2970831415173120 ((#1)^20)-258532084482048 ((#1)^22)+7836416409600 ((#1)^24)&,6], ])]]->ArcCos[(NumericalApproximation[Root, (RowDefault["-0.902", FEExpressionsNumericalApproximationElider]), Root[12633595858129-102010884561792 ((#1)^2)+2926005117403248 ((#1)^4)-34188564569482944 ((#1)^6)+142294272721388640 ((#1)^8)-292618531512025344 ((#1)^10)+336405217341259008 ((#1)^12)-225204354450994176 ((#1)^14)+88020632130289920 ((#1)^16)-20265400532643840 ((#1)^18)+2970831415173120 ((#1)^20)-258532084482048 ((#1)^22)+7836416409600 ((#1)^24)&,6], ])]

Union[%]

roots=Cases[res,_Root,∞]//Union

nroots=Length[roots]

vars=Array[a,nroots]

Cos[res]^2//N

FullSimplify[Cos[res]^2/.Thread[roots->vars],Element[vars,Reals]]

FullSimplify[((Sqrt[3-4 ((a[2])^2)])+a[6])/.Thread[vars->roots]]

((((-((a[1])^2) a[6]+a[3] (a[3]+a[4]+2 a[5]) a[6]+a[1] (Sqrt[(NumericalApproximation[Root, (RowDefault["2.09", FEExpressionsNumericalApproximationElider]), Root[11135569-641534720 #1+2051995120 ((#1)^2)+253365056 ((#1)^3)-5185957792 ((#1)^4)+2198553344 ((#1)^5)+2229503232 ((#1)^6)-1911223296 ((#1)^7)+371425536 ((#1)^8)+47648768 ((#1)^9)-19832832 ((#1)^10)+2424832 ((#1)^11)+65536 ((#1)^12)&,8], ])])))^2)/((((a[1])^2)+((a[3])^2)) ((a[6])^2) ((((a[3]+a[4]+2 a[5]))^2)+(((((Sqrt[(NumericalApproximation[Root, (RowDefault["2.09", FEExpressionsNumericalApproximationElider]), Root[11135569-641534720 #1+2051995120 ((#1)^2)+253365056 ((#1)^3)-5185957792 ((#1)^4)+2198553344 ((#1)^5)+2229503232 ((#1)^6)-1911223296 ((#1)^7)+371425536 ((#1)^8)+47648768 ((#1)^9)-19832832 ((#1)^10)+2424832 ((#1)^11)+65536 ((#1)^12)&,8], ])])-a[1] a[6]))^2)/((a[6])^2)))))/.Thread[vars->roots]//N

Expand[(-((a[1])^2) a[6]+a[3] (a[3]+a[4]+2 a[5]) a[6]+a[1] (Sqrt[(NumericalApproximation[Root, (RowDefault["2.09", FEExpressionsNumericalApproximationElider]), Root[11135569-641534720 #1+2051995120 ((#1)^2)+253365056 ((#1)^3)-5185957792 ((#1)^4)+2198553344 ((#1)^5)+2229503232 ((#1)^6)-1911223296 ((#1)^7)+371425536 ((#1)^8)+47648768 ((#1)^9)-19832832 ((#1)^10)+2424832 ((#1)^11)+65536 ((#1)^12)&,8], ])]))]

simp=FullSimplify[-((a[1])^2) a[6]+((a[3])^2) a[6]+a[3] a[4] a[6]+2 a[3] a[5] a[6]+a[1] (Sqrt[(NumericalApproximation[Root, (RowDefault["2.09", FEExpressionsNumericalApproximationElider]), Root[11135569-641534720 #1+2051995120 ((#1)^2)+253365056 ((#1)^3)-5185957792 ((#1)^4)+2198553344 ((#1)^5)+2229503232 ((#1)^6)-1911223296 ((#1)^7)+371425536 ((#1)^8)+47648768 ((#1)^9)-19832832 ((#1)^10)+2424832 ((#1)^11)+65536 ((#1)^12)&,8], ])])/.Thread[vars->roots]]

N[%]

Cos[res]^2//N

term8=ArcCos[-Sqrt[simp]]//FullSimplify

N[term8-res,50]

9

res=DihedralAngles[p][[9]]

ByteCount[res]

res//N

N[expr1=Cos[res]]

expr2=RootApproximant[N[expr1,300],24]

N[expr1-expr2,1000]

d/. 2.91141`->ArcCos[(NumericalApproximation[Root, (RowDefault["-0.974", FEExpressionsNumericalApproximationElider]), Root[4230439312+93361440 #1-33079140936 ((#1)^2)+31331885832 ((#1)^3)+45252569457 ((#1)^4)-69628319928 ((#1)^5)-5340446964 ((#1)^6)+47477198088 ((#1)^7)-17866980810 ((#1)^8)-7941066984 ((#1)^9)+6992582580 ((#1)^10)-1641089808 ((#1)^11)+119574225 ((#1)^12)&,1], ])]

Union[%]

roots=Cases[res,_Root,∞]//Union

nroots=Length[roots]

vars=Array[a,nroots]

FullSimplify[Cos[res]^2/.Thread[roots->vars],Element[vars,Reals]]

simp=FullSimplify[%/.Thread[vars->roots]]

N[%]

Cos[res]^2//N

term9=ArcCos[-Sqrt[simp]]//FullSimplify

N[term9-res,50]

EdgeCount

PolyhedronData["Disphenocingulum","EdgeCount"]

EdgeLengths

<<MathWorld`PolyhedronOperations`

PolyhedronData["Disphenocingulum","EdgeLengths"]

e=PolyhedronData["Disphenocingulum","Lines"]/.Line[{l__}]:>EuclideanDistance[l]

SimplifyNumericallyDistinct[e,Debug->True]//Union//Timing

FaceCount

PolyhedronData["Disphenocingulum","FaceCount"]

GeneralizedDiameter

PolyhedronData["Disphenocingulum","GeneralizedDiameter"]

diam=GeneralizedDiameter[p]

N[%]

FullSimplify[diam]//RootReduce

N[%]

InertiaTensor

PolyhedronData["Disphenocingulum","InertiaTensor"]

<<MathWorld`PolyhedronOperations`

PolyhedronInertiaTensor[N[p]]//Chop

PolyhedronInertiaTensor[p,Method->"GaussLaw"]

Simplified vertices

i=MomentOfInertia[PolyhedronData["Disphenocingulum","Polyhedron"]]

i/vol//N

i[[1,1]]/vol//Simplify

Unsimplified vertices

i=((MomentOfInertia[unsimplifiedp,{0,0,0}])/((NumericalApproximation[Root, (RowDefault["4.85", FEExpressionsNumericalApproximationElider]), Root[-3462502611005-21366006228456 #1-24213993614376 ((#1)^2)+20949288919776 ((#1)^3)+50390630355600 ((#1)^4)+22469827389696 ((#1)^5)-9157866303744 ((#1)^6)-11737675422720 ((#1)^7)-3890042724096 ((#1)^8)-203287283712 ((#1)^9)+159348529152 ((#1)^10)+28540035072 ((#1)^11)+725594112 ((#1)^12)&,8], ])/(Sqrt[4-((NumericalApproximation[Root, (RowDefault["1.53", FEExpressionsNumericalApproximationElider]), Root[-368-192 #1+2688 ((#1)^2)-1888 ((#1)^3)-2024 ((#1)^4)+2176 ((#1)^5)+312 ((#1)^6)-824 ((#1)^7)+97 ((#1)^8)+116 ((#1)^9)-26 ((#1)^10)-4 ((#1)^11)+((#1)^12)&,5], ])^2)])));

ByteCount[i]

i//N

i2=PolyhedronInertiaTensor[unsimplifiedp,((NumericalApproximation[Root, (RowDefault["4.85", FEExpressionsNumericalApproximationElider]), Root[-3462502611005-21366006228456 #1-24213993614376 ((#1)^2)+20949288919776 ((#1)^3)+50390630355600 ((#1)^4)+22469827389696 ((#1)^5)-9157866303744 ((#1)^6)-11737675422720 ((#1)^7)-3890042724096 ((#1)^8)-203287283712 ((#1)^9)+159348529152 ((#1)^10)+28540035072 ((#1)^11)+725594112 ((#1)^12)&,8], ])/(Sqrt[4-((NumericalApproximation[Root, (RowDefault["1.53", FEExpressionsNumericalApproximationElider]), Root[-368-192 #1+2688 ((#1)^2)-1888 ((#1)^3)-2024 ((#1)^4)+2176 ((#1)^5)+312 ((#1)^6)-824 ((#1)^7)+97 ((#1)^8)+116 ((#1)^9)-26 ((#1)^10)-4 ((#1)^11)+((#1)^12)&,5], ])^2)])),Identity,Identity];

ByteCount[i2]

N[i2]

FullSimplify[i2]//Timing

N[%[[2]]]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p,"Simplification"->FullSimplify]

MeanCylindricalRadius

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))

(i=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSquareCylindricalRadius

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

(r=RootApproximant[N[i,2000],64])//Timing

N[i-r,5000]//N[#,20]&

MeanSphericalRadius

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))

(i=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSquareSphericalRadius

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))

(i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

(r=RootApproximant[N[i,2000],64])//Timing

N[i-r,5000]//N[#,20]&

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]//Timing

RegionFunction

Root objects could be simplified

reg=PolyhedronData["Disphenocingulum","RegionFunction"]

bounds=RegionBounds[ImplicitRegion[reg[x,y,z],{x,y,z}]]

ranges=Flatten/@Transpose[{{x,y,z},{-1,1}.1+#&/@bounds}]

RegionPlot3D[Evaluate[reg[x,y,z]],Evaluate[Sequence@@ranges],BoxRatios->Automatic,PlotPoints->40]

PolyhedronInequalities[p,{#1,#2,#3}]/.Times[r__Root]:>RootReduce[Times[r]]

TimeConstrained[RootReduce[PolyhedronInequalities[p,{#1,#2,#3}]],60]

Skeleton

g=PolyhedronData["Disphenocingulum","Skeleton"]

r=RecognizeGraph[g]

GraphData[r,"Graph","All"]

ToCommonEdges[GraphData[r],g]

SurfaceArea

PolyhedronData["Disphenocingulum","SurfaceArea"]

VertexCoordinates

v0=PolyhedronData["Disphenocingulum","VertexCoordinates"]

expr1=(NumericalApproximation[Root, (RowDefault["-0.779", FEExpressionsNumericalApproximationElider]), Root[1+20 ((#1)^2)-138 ((#1)^4)-1692 ((#1)^6)+20065 ((#1)^8)-80496 ((#1)^10)+120080 ((#1)^12)+140608 ((#1)^14)-846496 ((#1)^16)+1355520 ((#1)^18)-941312 ((#1)^20)+178176 ((#1)^22)+57600 ((#1)^24)&,2], ])+(NumericalApproximation[Root, (RowDefault["1.10", FEExpressionsNumericalApproximationElider]), Root[14641+631136 ((#1)^2)-4124152 ((#1)^4)+48951424 ((#1)^6)-111801072 ((#1)^8)-526660608 ((#1)^10)+166375424 ((#1)^12)+799604736 ((#1)^14)+70647808 ((#1)^16)-79691776 ((#1)^18)-352321536 ((#1)^20)-268435456 ((#1)^22)+268435456 ((#1)^24)&,7], ]);

(expr2=RootApproximant[N[expr1,500],24])//Timing

FullSimplify[expr1-expr2]

RootReduce[expr1-expr2]

N[expr1-expr2,3000]

v1=v0/.{-(NumericalApproximation[Root, (RowDefault["0.779", FEExpressionsNumericalApproximationElider]), Root[1+20 ((#1)^2)-138 ((#1)^4)-1692 ((#1)^6)+20065 ((#1)^8)-80496 ((#1)^10)+120080 ((#1)^12)+140608 ((#1)^14)-846496 ((#1)^16)+1355520 ((#1)^18)-941312 ((#1)^20)+178176 ((#1)^22)+57600 ((#1)^24)&,7], ])+(NumericalApproximation[Root, (RowDefault["1.10", FEExpressionsNumericalApproximationElider]), Root[14641+631136 ((#1)^2)-4124152 ((#1)^4)+48951424 ((#1)^6)-111801072 ((#1)^8)-526660608 ((#1)^10)+166375424 ((#1)^12)+799604736 ((#1)^14)+70647808 ((#1)^16)-79691776 ((#1)^18)-352321536 ((#1)^20)-268435456 ((#1)^22)+268435456 ((#1)^24)&,7], ])->(NumericalApproximation[Root, (RowDefault["0.325", FEExpressionsNumericalApproximationElider]), Root[2209-1436544 ((#1)^2)+216014664 ((#1)^4)+376397056 ((#1)^6)-12078370032 ((#1)^8)-65149629440 ((#1)^10)-258660978688 ((#1)^12)-50417041408 ((#1)^14)+1208931975168 ((#1)^16)+2202231898112 ((#1)^18)+1595228028928 ((#1)^20)+512980156416 ((#1)^22)+60397977600 ((#1)^24)&,7], ]),(NumericalApproximation[Root, (RowDefault["0.779", FEExpressionsNumericalApproximationElider]), Root[1+20 ((#1)^2)-138 ((#1)^4)-1692 ((#1)^6)+20065 ((#1)^8)-80496 ((#1)^10)+120080 ((#1)^12)+140608 ((#1)^14)-846496 ((#1)^16)+1355520 ((#1)^18)-941312 ((#1)^20)+178176 ((#1)^22)+57600 ((#1)^24)&,7], ])-(NumericalApproximation[Root, (RowDefault["1.10", FEExpressionsNumericalApproximationElider]), Root[14641+631136 ((#1)^2)-4124152 ((#1)^4)+48951424 ((#1)^6)-111801072 ((#1)^8)-526660608 ((#1)^10)+166375424 ((#1)^12)+799604736 ((#1)^14)+70647808 ((#1)^16)-79691776 ((#1)^18)-352321536 ((#1)^20)-268435456 ((#1)^22)+268435456 ((#1)^24)&,7], ])->-(NumericalApproximation[Root, (RowDefault["0.325", FEExpressionsNumericalApproximationElider]), Root[2209-1436544 ((#1)^2)+216014664 ((#1)^4)+376397056 ((#1)^6)-12078370032 ((#1)^8)-65149629440 ((#1)^10)-258660978688 ((#1)^12)-50417041408 ((#1)^14)+1208931975168 ((#1)^16)+2202231898112 ((#1)^18)+1595228028928 ((#1)^20)+512980156416 ((#1)^22)+60397977600 ((#1)^24)&,7], ])}

N[v1-v0,1000]

expr3=expr1+(NumericalApproximation[Root, (RowDefault["-1.56", FEExpressionsNumericalApproximationElider]), Root[65536+327680 ((#1)^2)-565248 ((#1)^4)-1732608 ((#1)^6)+5136640 ((#1)^8)-5151744 ((#1)^10)+1921280 ((#1)^12)+562432 ((#1)^14)-846496 ((#1)^16)+338880 ((#1)^18)-58832 ((#1)^20)+2784 ((#1)^22)+225 ((#1)^24)&,2], ])/2;

N[expr3]

N[(1/2) ((NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[57600+178176 ((#1)^2)-941312 ((#1)^4)+1355520 ((#1)^6)-846496 ((#1)^8)+140608 ((#1)^10)+120080 ((#1)^12)-80496 ((#1)^14)+20065 ((#1)^16)-1692 ((#1)^18)-138 ((#1)^20)+20 ((#1)^22)+((#1)^24)&,6], ])+(NumericalApproximation[Root, (RowDefault["-1.56", FEExpressionsNumericalApproximationElider]), Root[65536+327680 ((#1)^2)-565248 ((#1)^4)-1732608 ((#1)^6)+5136640 ((#1)^8)-5151744 ((#1)^10)+1921280 ((#1)^12)+562432 ((#1)^14)-846496 ((#1)^16)+338880 ((#1)^18)-58832 ((#1)^20)+2784 ((#1)^22)+225 ((#1)^24)&,2], ])+(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[5041-12820 ((#1)^2)-353354 ((#1)^4)+1403420 ((#1)^6)-1647087 ((#1)^8)+35184 ((#1)^10)+999920 ((#1)^12)-237888 ((#1)^14)-271776 ((#1)^16)+34048 ((#1)^18)+39168 ((#1)^20)+6144 ((#1)^22)+256 ((#1)^24)&,7], ]))]

expr4=RootApproximant[N[expr3,1000],24]

exp2

expr2

No simplification

aroot=Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5]

hroot=With[{a=aroot},(Sqrt[2+8a-8(a^2)])]

croot=With[{a=aroot},(Sqrt[1-(a^2)])]

onev=With[{a=aroot,c=croot,h=hroot},{{1,2a,(h/2)},{1,0,2c+(h/2)},{1+((Sqrt[3-4(a^2)])/c),0,2c-(1/c)+(h/2)}}];

rotv=RotationMatrix[π,{1,1,0}].#&/@onev;

rotv2=RotationMatrix[π,{-1,1,0}].#&/@onev;

v=(Flatten[{
onev,rotv,rotv,
f1={#,-#2,#3}&@@@onev,
f2={#,-#2,#3}&@@@rotv,
f3={#,-#2,#3}&@@@rotv2,
ff=RotationMatrix[π,{1,1,0}].#&/@({#,-#2,#3}&@@@onev),
RotationMatrix[π,{-1,1,0}].#&/@({#,-#2,#3}&@@@onev),
RotationMatrix[π,{1,1,0}].#&/@f1,
fg=RotationMatrix[π,{1,1,0}].#&/@f2,
RotationMatrix[π,{1,1,0}].#&/@f3,
RotationMatrix[π,{-1,1,0}].#&/@f1,
RotationMatrix[π,{-1,1,0}].#&/@f2,
RotationMatrix[π,{-1,1,0}].#&/@f3,
{#,-#2,#3}&@@@ff,
{#,-#2,#3}&@@@fg
},1]//Union)/2

v={{-(1/2),0,(1/2) ((1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])+2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{-(1/2),-(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{-(1/2),(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{0,-(1/2),(1/2) (-(1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])-2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{0,(1/2),(1/2) (-(1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])-2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{0,(1/2) (-1-(Sqrt[((3-4 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2))/(1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)))])),(1/2) (-(1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])+(1/(Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))-2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{0,(1/2) (1+(Sqrt[((3-4 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2))/(1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)))])),(1/2) (-(1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])+(1/(Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))-2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{(1/2),0,(1/2) ((1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])+2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{(1/2),-(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{(1/2),(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{-(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),-(1/2),-(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{-(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),(1/2),-(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),-(1/2),-(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]),(1/2),-(1/4) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])},{(1/2) (-1-(Sqrt[((3-4 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2))/(1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)))])),0,(1/2) ((1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])-(1/(Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))+2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))},{(1/2) (1+(Sqrt[((3-4 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2))/(1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)))])),0,(1/2) ((1/2) (Sqrt[2+8 (NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])-8 ((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)])-(1/(Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))+2 (Sqrt[1-((NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ])^2)]))}};

Length[v]

N[v-PolyhedronCoordinates[p],100]

faces={{1,3,15},{1,15,2},{2,6,9},{2,11,6},{2,15,11},{3,7,12},{3,10,7},{3,12,15},{4,6,11},{4,13,6},{5,7,14},{5,12,7},{6,13,9},{7,10,14},{8,9,16},{8,16,10},{9,13,16},{10,16,14},{11,15,12},{13,14,16},{1,2,9,8},{1,8,10,3},{4,5,14,13},{4,11,12,5}};

unsimplifiedp=Polyhedron[v,faces]

Volume[unsimplifiedp//N]

FullSimplify of final combinations of unsimplified roots

aroot=(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]);

hroot=With[{a=aroot},(Sqrt[2+8a-8(a^2)])]

croot=With[{a=aroot},(Sqrt[1-(a^2)])]

N[onev0=With[{a=aroot,c=croot,h=hroot},{{1,2a,(h/2)},{1,0,2c+(h/2)},{1+((Sqrt[3-4(a^2)])/c),0,2c-(1/c)+(h/2)}}]]

N[onev=With[{a=aroot,c=croot,h=hroot},{{1,2a,(h/2)},{1,0,2c+(h/2)},{1+2 (NumericalApproximation[Root, (RowDefault["0.626", FEExpressionsNumericalApproximationElider]), Root[44-32 #1-476 ((#1)^2)+496 ((#1)^3)+1647 ((#1)^4)-1856 ((#1)^5)-2696 ((#1)^6)+2928 ((#1)^7)+2360 ((#1)^8)-2112 ((#1)^9)-1120 ((#1)^10)+576 ((#1)^11)+240 ((#1)^12)&,7], ]),0,(Sqrt[(NumericalApproximation[Root, (RowDefault["0.423", FEExpressionsNumericalApproximationElider]), Root[35344-5746176 #1+216014664 ((#1)^2)+94099264 ((#1)^3)-754898127 ((#1)^4)-1017962960 ((#1)^5)-1010394448 ((#1)^6)-49235392 ((#1)^7)+295149408 ((#1)^8)+134413568 ((#1)^9)+24341248 ((#1)^10)+1956864 ((#1)^11)+57600 ((#1)^12)&,7], ])])}}]]

onev0-onev//N

onev

rotv=RotationMatrix[π,{1,1,0}].#&/@onev;

rotv2=RotationMatrix[π,{-1,1,0}].#&/@onev;

v=(Flatten[{
onev,rotv,rotv,
f1={#,-#2,#3}&@@@onev,
f2={#,-#2,#3}&@@@rotv,
f3={#,-#2,#3}&@@@rotv2,
ff=RotationMatrix[π,{1,1,0}].#&/@({#,-#2,#3}&@@@onev),
RotationMatrix[π,{-1,1,0}].#&/@({#,-#2,#3}&@@@onev),
RotationMatrix[π,{1,1,0}].#&/@f1,
fg=RotationMatrix[π,{1,1,0}].#&/@f2,
RotationMatrix[π,{1,1,0}].#&/@f3,
RotationMatrix[π,{-1,1,0}].#&/@f1,
RotationMatrix[π,{-1,1,0}].#&/@f2,
RotationMatrix[π,{-1,1,0}].#&/@f3,
{#,-#2,#3}&@@@ff,
{#,-#2,#3}&@@@fg
},1]//Union)/2

Sort[N[v]]-Sort[N[PolyhedronCoordinates[p]]]//Chop

FullSimplify[v]

Length[v]

N[v-PolyhedronCoordinates[p]]

FullSimplify[

faces={{1,3,15},{1,15,2},{2,6,9},{2,11,6},{2,15,11},{3,7,12},{3,10,7},{3,12,15},{4,6,11},{4,13,6},{5,7,14},{5,12,7},{6,13,9},{7,10,14},{8,9,16},{8,16,10},{9,13,16},{10,16,14},{11,15,12},{13,14,16},{1,2,9,8},{1,8,10,3},{4,5,14,13},{4,11,12,5}};

unsimplifiedp=Polyhedron[v,faces]

Volume[unsimplifiedp//N]

VertexCount

PolyhedronData["Disphenocingulum","VertexCount"]

Volume

vol=PolyhedronData["Disphenocingulum","Volume"]

N[%]

Volume[unsimplifiedp]//N

Volume[p]//N

PolyhedronVolume[p]//N

PolyhedronVolume[unsimplifiedp]//N

Using Root-Reduced vertices

(v1=Volume[p])//N

ByteCount[v1]

vol=(2-8 ((Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5])^2)+2 (Sqrt[3-4 ((Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5])^2)]) Root[330366976-210042880 ((#1)^2)-1447337984 ((#1)^4)+1437102080 ((#1)^6)-421654272 ((#1)^8)+2251776 ((#1)^10)+15998720 ((#1)^12)-951552 ((#1)^14)-271776 ((#1)^16)+8512 ((#1)^18)+2448 ((#1)^20)+96 ((#1)^22)+((#1)^24)&,7]+4 Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5] (Sqrt[3-4 ((Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5])^2)]) Root[330366976-210042880 ((#1)^2)-1447337984 ((#1)^4)+1437102080 ((#1)^6)-421654272 ((#1)^8)+2251776 ((#1)^10)+15998720 ((#1)^12)-951552 ((#1)^14)-271776 ((#1)^16)+8512 ((#1)^18)+2448 ((#1)^20)+96 ((#1)^22)+((#1)^24)&,7]+8 Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5] (Sqrt[3-4 ((Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5])^2)]) Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6]+Root[330366976-210042880 ((#1)^2)-1447337984 ((#1)^4)+1437102080 ((#1)^6)-421654272 ((#1)^8)+2251776 ((#1)^10)+15998720 ((#1)^12)-951552 ((#1)^14)-271776 ((#1)^16)+8512 ((#1)^18)+2448 ((#1)^20)+96 ((#1)^22)+((#1)^24)&,7] Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6]+8 Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5] Root[330366976-210042880 ((#1)^2)-1447337984 ((#1)^4)+1437102080 ((#1)^6)-421654272 ((#1)^8)+2251776 ((#1)^10)+15998720 ((#1)^12)-951552 ((#1)^14)-271776 ((#1)^16)+8512 ((#1)^18)+2448 ((#1)^20)+96 ((#1)^22)+((#1)^24)&,7] Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6]+4 ((Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5])^2) Root[330366976-210042880 ((#1)^2)-1447337984 ((#1)^4)+1437102080 ((#1)^6)-421654272 ((#1)^8)+2251776 ((#1)^10)+15998720 ((#1)^12)-951552 ((#1)^14)-271776 ((#1)^16)+8512 ((#1)^18)+2448 ((#1)^20)+96 ((#1)^22)+((#1)^24)&,7] Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6]-4 ((Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6])^2)+24 Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5] ((Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6])^2)+16 ((Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5])^2) ((Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6])^2))/(12 Root[225+2784 ((#1)^2)-58832 ((#1)^4)+338880 ((#1)^6)-846496 ((#1)^8)+562432 ((#1)^10)+1921280 ((#1)^12)-5151744 ((#1)^14)+5136640 ((#1)^16)-1732608 ((#1)^18)-565248 ((#1)^20)+327680 ((#1)^22)+65536 ((#1)^24)&,6]);

v1

(v2=PolyhedronVolume[p])//N

ByteCount[v2]

Using unsimplified vertices

vol1=Volume[unsimplifiedp]//Simplify

N[vol1]

ByteCount[vol1]

FullSimplify[vol1]//Timing

N[newvol=((NumericalApproximation[Root, (RowDefault["4.85", FEExpressionsNumericalApproximationElider]), Root[-3462502611005-21366006228456 #1-24213993614376 ((#1)^2)+20949288919776 ((#1)^3)+50390630355600 ((#1)^4)+22469827389696 ((#1)^5)-9157866303744 ((#1)^6)-11737675422720 ((#1)^7)-3890042724096 ((#1)^8)-203287283712 ((#1)^9)+159348529152 ((#1)^10)+28540035072 ((#1)^11)+725594112 ((#1)^12)&,8], ])/(Sqrt[4-((NumericalApproximation[Root, (RowDefault["1.53", FEExpressionsNumericalApproximationElider]), Root[-368-192 #1+2688 ((#1)^2)-1888 ((#1)^3)-2024 ((#1)^4)+2176 ((#1)^5)+312 ((#1)^6)-824 ((#1)^7)+97 ((#1)^8)+116 ((#1)^9)-26 ((#1)^10)-4 ((#1)^11)+((#1)^12)&,5], ])^2)]))]

RootReduce[newvol]//Timing

N[(NumericalApproximation[Root, (RowDefault["3.78", FEExpressionsNumericalApproximationElider]), Root[479556973248657693884401-3212114716816853362953264 ((#1)^2)-5891096640600351061013664 ((#1)^4)+48042947402464500749392128 ((#1)^6)+14389309497459555704164608 ((#1)^8)-63327534106871321714442240 ((#1)^10)+246234688242991598853881856 ((#1)^12)-133907540390420673677230080 ((#1)^14)+20902529024429842816303104 ((#1)^16)-4133410366404688544268288 ((#1)^18)-796837093078664749252608 ((#1)^20)+54451372392730545094656 ((#1)^22)+1213025622610333925376 ((#1)^24)&,8], ])]

vol2=PolyhedronVolume[unsimplifiedp];

N[vol2]

ByteCount[vol2]

Construction

Timofeenko, A.~V.  ``The Non-Platonic and Non-Archimedean Noncomposite Polyhedra.''  {\it J.\ Math.\ Sci.} {\bf 162}, 710--729, 2009.

eqn=-23-24x+672x^2-944x^3-2024x^4+4352x^5+1248x^6-6592x^7+1552x^8+3712x^9-1664x^10-512x^11+256x^12;

soln=Reduce[eqn==0,x,Reals][[All,2]]

N[soln]

N[aroot=soln[[5]]]

aroot=(NumericalApproximation[Root, (RowDefault["0.767", FEExpressionsNumericalApproximationElider]), Root[-23-24 #1+672 ((#1)^2)-944 ((#1)^3)-2024 ((#1)^4)+4352 ((#1)^5)+1248 ((#1)^6)-6592 ((#1)^7)+1552 ((#1)^8)+3712 ((#1)^9)-1664 ((#1)^10)-512 ((#1)^11)+256 ((#1)^12)&,5], ]);

(hroot=With[{a=aroot},(Sqrt[2+8a-8(a^2)])])//RootReduce

(croot=With[{a=aroot},(Sqrt[1-(a^2)])])//RootReduce

onev=With[{a=aroot,c=croot,h=hroot},{{1,2a,(h/2)},{1,0,2c+(h/2)},{1+((Sqrt[3-4(a^2)])/c),0,2c-(1/c)+(h/2)}}];

onev//N

With[{a=aroot,c=croot,h=hroot},RootReduce[{1,2a,(h/2)}]]

N[newonev=With[{a=aroot,c=croot,h=hroot},{{1,,},{1,0,2c+(h/2)},{1+((Sqrt[3-4(a^2)])/c),0,2c-(1/c)+(h/2)}}],20]==N[onev,20]

With[{a=aroot,c=croot,h=hroot},RootReduce[1+((Sqrt[3-4(a^2)])/c)]]

N[newonev=With[{a=aroot,c=croot,h=hroot},{{1,,},{1,0,2c+(h/2)},{Root[-3337+5524 #1+32302 ((#1)^2)+3940 ((#1)^3)-43007 ((#1)^4)-440 ((#1)^5)+24804 ((#1)^6)-5560 ((#1)^7)-5191 ((#1)^8)+2404 ((#1)^9)-82 ((#1)^10)-108 ((#1)^11)+15 ((#1)^12)&,7],0,2c-(1/c)+(h/2)}}],20]==N[onev,20]

With[{a=aroot,c=croot,h=hroot},(r1=RootReduce[2c])+(r2=RootReduce[(h/2)])]

Missing r1+r2 and r1+r2+r3 exact values

N[r1+r2]

RootReduce[r1+r2]//Timing

With[{a=aroot,c=croot,h=hroot},r3=RootReduce[-(1/c)]]

RootReduce[r1+r3]

With[{a=aroot,c=croot,h=hroot},r1+r2+r3]

N[%]

N[newonev=With[{a=aroot,c=croot,h=hroot},{{1,,},{1,0,(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[57600+178176 ((#1)^2)-941312 ((#1)^4)+1355520 ((#1)^6)-846496 ((#1)^8)+140608 ((#1)^10)+120080 ((#1)^12)-80496 ((#1)^14)+20065 ((#1)^16)-1692 ((#1)^18)-138 ((#1)^20)+20 ((#1)^22)+((#1)^24)&,6], ])+(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[5041-12820 ((#1)^2)-353354 ((#1)^4)+1403420 ((#1)^6)-1647087 ((#1)^8)+35184 ((#1)^10)+999920 ((#1)^12)-237888 ((#1)^14)-271776 ((#1)^16)+34048 ((#1)^18)+39168 ((#1)^20)+6144 ((#1)^22)+256 ((#1)^24)&,7], ])},{1+((Sqrt[3-4(a^2)])/c),0,(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[57600+178176 ((#1)^2)-941312 ((#1)^4)+1355520 ((#1)^6)-846496 ((#1)^8)+140608 ((#1)^10)+120080 ((#1)^12)-80496 ((#1)^14)+20065 ((#1)^16)-1692 ((#1)^18)-138 ((#1)^20)+20 ((#1)^22)+((#1)^24)&,6], ])+(NumericalApproximation[Root, (RowDefault["-1.56", FEExpressionsNumericalApproximationElider]), Root[65536+327680 ((#1)^2)-565248 ((#1)^4)-1732608 ((#1)^6)+5136640 ((#1)^8)-5151744 ((#1)^10)+1921280 ((#1)^12)+562432 ((#1)^14)-846496 ((#1)^16)+338880 ((#1)^18)-58832 ((#1)^20)+2784 ((#1)^22)+225 ((#1)^24)&,2], ])+(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[5041-12820 ((#1)^2)-353354 ((#1)^4)+1403420 ((#1)^6)-1647087 ((#1)^8)+35184 ((#1)^10)+999920 ((#1)^12)-237888 ((#1)^14)-271776 ((#1)^16)+34048 ((#1)^18)+39168 ((#1)^20)+6144 ((#1)^22)+256 ((#1)^24)&,7], ])}}],20]==N[onev,20]

rotv=RotationMatrix[π,{1,1,0}].#&/@newonev;

rotv2=RotationMatrix[π,{-1,1,0}].#&/@newonev;

(v=Flatten[{
newonev,rotv,rotv,
f1={#,-#2,#3}&@@@newonev,
f2={#,-#2,#3}&@@@rotv,
f3={#,-#2,#3}&@@@rotv2,
ff=RotationMatrix[π,{1,1,0}].#&/@({#,-#2,#3}&@@@newonev),
RotationMatrix[π,{-1,1,0}].#&/@({#,-#2,#3}&@@@newonev),
RotationMatrix[π,{1,1,0}].#&/@f1,
fg=RotationMatrix[π,{1,1,0}].#&/@f2,
RotationMatrix[π,{1,1,0}].#&/@f3,
RotationMatrix[π,{-1,1,0}].#&/@f1,
RotationMatrix[π,{-1,1,0}].#&/@f2,
RotationMatrix[π,{-1,1,0}].#&/@f3,
{#,-#2,#3}&@@@ff,
{#,-#2,#3}&@@@fg
},1]//Union)

Length[v]

v

Graphics3D[{PointSize[.05],Point[Drop[v,3]//Union],{Red,Point[Take[v,3]]}},Axes->True,AxesOrigin->{0,0,0},AxesLabel->{"x","y","z"}]

PolyhedronData["Disphenocingulum","V"]

ConvexHullMesh[v]

PolyhedronData["Disphenocingulum","E"]

e=Select[Subsets[Range[16],{2}],N[EuclideanDistance@@v[[#]],20]==2.&]

Length[e]

SmallestRotation[l_]:=Sort[NestList[RotateRight,l,Length[l]-1]][[1]]

tri=Sort[SmallestRotation/@FindCycle[Graph[Range[16],UndirectedEdge@@@e],{3},All][[All,All,1]]]

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,v],FaceForm[Green,Red],Polygon[v[[#]]]&/@tri}]

tri=Sort[SmallestRotation/@{Reverse@{1,2,15},{1,3,15},Reverse@{2,9,6},{2,11,6},{2,15,11},{3,10,7},Reverse@{3,12,7},{3,12,15},{4,6,11},{4,13,6},Reverse@{5,7,12},{5,7,14},Reverse@{6,9,13},Reverse@{7,14,10},{8,9,16},{8,16,10},{9,13,16},Reverse@{10,14,16},Reverse@{11,12,15},Reverse@{13,16,14}}]

tri={{1,3,15},{1,15,2},{2,6,9},{2,11,6},{2,15,11},{3,7,12},{3,10,7},{3,12,15},{4,6,11},{4,13,6},{5,7,14},{5,12,7},{6,13,9},{7,10,14},{8,9,16},{8,16,10},{9,13,16},{10,16,14},{11,15,12},{13,14,16}};

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,v],FaceForm[Green,Red],Polygon[v[[#]]]&/@tri}]

squares={{1,8,10,3},{1,2,9,8},{4,11,12,5},{4,5,14,13}};

faces=Union[tri,squares]

faces={{1,3,15},{1,15,2},{2,6,9},{2,11,6},{2,15,11},{3,7,12},{3,10,7},{3,12,15},{4,6,11},{4,13,6},{5,7,14},{5,12,7},{6,13,9},{7,10,14},{8,9,16},{8,16,10},{9,13,16},{10,16,14},{11,15,12},{13,14,16},{1,2,9,8},{1,8,10,3},{4,5,14,13},{4,11,12,5}};

Length[faces]

PolyhedronData["Disphenocingulum","F"]

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,v],FaceForm[Green,Red],Polygon[v[[#]]]&/@faces}]

p=Polyhedron[v/2,faces]

Graphics3D[p]

FullSimplified but not root-reduced