Trapezohedron

Author

Eric W. Weisstein
September 29, 2022

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

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

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

Graphics

Based on pitch angle

GraphicsRow[Graphics3D[{Opacity[.8],Trapezohedron[#,#2Degree]},Method->{"ShrinkWrap"->True},Boxed->False]&@@@{{3,50},{4,40},{5,26.56},{6,26.56}}]

Canonical

GraphicsGrid[Partition[Table[Graphics3D[{Opacity[.8],Trapezohedron[n]},Boxed->False,ViewPoint->{.3,2,.2},Method->{"ShrinkWrap"->True}],{n,3,10}],UpTo[4]]]//Quiet

Canonical with antiprisms

GraphicsRow[Table[Graphics3D[{Opacity[.5],
Red,Trapezohedron[n],
Yellow,Sphere[{0,0,0},1/4 Csc[Pi/(2 n)]],
Green,Antiprism[n]},Boxed->False,Method->{"ShrinkWrap"->True}],{n,3,6}],Spacings->100]

Duals.m

GraphicsGrid[Partition[Table[Quiet@Graphics3D[N[Dual[Normal@PolyhedronData[{"Antiprism",n}/.{"Antiprism",3}->{"Octahedron","C3"},"Faces"],Method->Semiregular]],Boxed->False,ViewPoint->{1,1,.1}],
{n,3,10}],4],Spacings->{-100,-40}
]

Special 10-trapezohedron

Non-canonical but with many right dihedral angles:

https://community.wolfram.com/groups/-/m/t/1330352

np={{1,0,1/2 Sqrt[-2+Sqrt[5]]},{1,1/2 (3-Sqrt[5]),1/2 Sqrt[5 (-2+Sqrt[5])]},{1/2 (-1+Sqrt[5]),1/2 (-1+Sqrt[5]),3/2 Sqrt[-2+Sqrt[5]]},{1/2 (3-Sqrt[5]),1,1/2 Sqrt[5 (-2+Sqrt[5])]},{0,1,1/2 Sqrt[-2+Sqrt[5]]},{0,1,-(1/2) Sqrt[-2+Sqrt[5]]},{0,1/2 (-1+Sqrt[5]),-(1/2) Sqrt[5 (-2+Sqrt[5])]},{1/2 (3-Sqrt[5]),1/2 (3-Sqrt[5]),-(3/2) Sqrt[-2+Sqrt[5]]},{1/2 (-1+Sqrt[5]),0,-(1/2) Sqrt[5 (-2+Sqrt[5])]},{1,0,-(1/2) Sqrt[-2+Sqrt[5]]},{1,1,-(1/2) Sqrt[-2+Sqrt[5]]},{0,0,1/2 Sqrt[-2+Sqrt[5]]}};
Graphics3D[{Table[Style[Text[n,np[[n]]],20],{n,1,12}],Opacity[.7],Table[Polygon[np[[Append[Mod[{a,a+1,a+2},10,1],11+If[OddQ[a],1,0]]]]],{a,1,10}],Opacity[.3],Blue,Polygon[{{0,0,-1/2},{1,0,-1/2},{1,1,-1/2},{0,1,-1/2},{0,0,-1/2}}],Polygon[{{0,0,1/2},{1,0,1/2},{1,1,1/2},{0,1,1/2},{0,0,1/2}}]},SphericalRegion->True,Boxed->False]

Graphics3D[poly=ConvexHullRegion[np]]

faces=PolyhedronFaces[poly]

v=PolyhedronCoordinates[poly];

dihedral=DihedralAngles[poly]//FullSimplify

rt=Cases[Transpose[{AdjacentFaceIndices[poly],dihedral}],{pair_,Pi/2}:>pair]

Length[rt]

Graphics3D[{{Opacity[.5],poly},Red,Polygon[v[[faces[[#]]]]]&/@rt[[1]]},Boxed->False]

Description

Russel Towle

These right regular trapezohedra form but one of many different possible classes of such solids.  I define a trapezium as a kite-shaped polygon. These trapezohedra are bounded by 2*n trapezia, which interlock around the equator.  While they resemble, at a glance, the bipyramids, these trapezohedra are better understood as the forms obtained by producing the planes of the lateral faces of a right regular antiprism until they meet at two apices on the symmetry axis of the antiprism (look for the "equatorial" antiprism in the examples).  

The function accepts two arguments, n and pitch, which are identical to those required by the Antiprism function (see above).  It would be better to define pitch like it is in the Bipyramid function, and let the inscribed antiprism follow, but in this function, the inscribed antiprism is defined, and the n edges which meet at each of the two apices must follow.  Thus, the effect of a particular pitch angle is different for different n.  Experiment.

Addendum:  I introduced a parameter called "pitch." This the word carpenters use to describe the angle between a roof rafter and a horizontal plane. In a pyramid it is the angle between a "lateral" edge (connecting apex to base) and the base. Hence 0<=pitch<=90 degrees. And so in the function below, with 3<=n. Except here, pitch refers to the angle between the "lateral" edges of the inscribed equatorial antiprism.

Properties: {"Trapezohedron", n}

Dual

Table[Graphics3D[{
PolyhedronData[{"Trapezohedron",n},"Dual","Polyhedron"],
PolyhedronData[{"Trapezohedron",n},"Polyhedron"]}],
{n,3,10}]

Table[Graphics3D[{
PolyhedronData[{"Trapezohedron",n},"Dual","Polyhedron"],
PolyhedronData[{"Trapezohedron",n},"Polyhedron"]}],
{n,3,10}]

DualScale

Table[PolyhedronData[{"Trapezohedron",n},"DualScale"],{n,3,10}]

Table[(Sqrt[1+2 Cos[(π/n)]]),{n,3,10}]//FullSimplify

FullSimplify[(1/(Sqrt[1+2 Cos[(π/n)]]))]

EdgeCount

Table[PolyhedronData[{"Trapezohedron",n},"EdgeCount"],{n,3,10}]

Table[4 n,{n,3,10}]

EdgeLengths

Rest/@Table[PolyhedronData[{"Trapezohedron",n},"EdgeLengths"],{n,3,10}]//RootReduce//FullSimplify

Table[(1/(2-2 Cos[(π/n)])),{n,3,10}]//FullSimplify

RootReduce[%]//FullSimplify

FaceCount

Table[PolyhedronData[{"Trapezohedron",n},"FaceCount"],{n,3,10}]

Table[2n,{n,3,10}]

FaceCountRules

Table[PolyhedronData[{"Trapezohedron",n},"FaceCountRules"],{n,3,10}]

GeneralizedDiameter

Table[PolyhedronData[{"Trapezohedron",n},"GeneralizedDiameter"],{n,3,10}]

Table[(1/2) Cot[(π/(2n))] Csc[(π/(2n))],{n,3,10}]//FullSimplify

Insphere

Table[PolyhedronData[{"Trapezohedron",n},"Insphere"],{n,3,10}]

Table[Graphics3D[{Opacity[.5],{Yellow,PolyhedronData[{"Trapezohedron",n},"Polyhedron"]},Red,PolyhedronData[{"Trapezohedron",n},"Insphere"]}],{n,3,10}]

Table[(((Sqrt[-1+(4/(1+2 Cos[(π/n)]))]) ((Csc[(π/(2 n))])^2) (Sqrt[4-((Sec[(π/(2 n))])^2)]) Sin[(π/n)])/(24-16 Cos[(π/n)]))(Sqrt[1+2 Cos[(π/n)]]),{n,3,5}]//FullSimplify

FullSimplify[(((Sqrt[(-1+(4/(1+2 Cos[(π/n)])))(4-((Sec[(π/(2 n))])^2))(1+2 Cos[(π/n)])]) ((Csc[(π/(2 n))])^2)  Sin[(π/n)])/(24-16 Cos[(π/n)]))]

Table[(((Sqrt[(2 Cos[(π/n)]-3) (((Sec[(π/(2 n))])^2)-4)]) Sin[(π/n)])/(4 (4-5 Cos[(π/n)]+Cos[((2 π)/n)]))),{n,3,5}]//FullSimplify

Midsphere

Table[PolyhedronData[{"Trapezohedron",n},"Midradius"],{n,3,10}]//FullSimplify

FullSimplify[((1/4 Csc[Pi/(2 n)])/(1/(Sqrt[1+2 Cos[(π/n)]])))]

TextGrid[Table[{n,(1/4) (Sqrt[1+2 Cos[(π/n)]]) Csc[(π/(2 n))]},{n,3,10}]//FunctionExpand//FullSimplify,Dividers->All]

ToRadicals[(1/2) (NumericalApproximation[Root, (RowDefault["5.44", FEExpressionsNumericalApproximationElider]), Root[1+22 ((#1)^2)+69 ((#1)^4)-32 ((#1)^6)+((#1)^8)&,4], ])]//FullSimplify

SurfaceArea

Table[PolyhedronData[{"Trapezohedron",n},"SurfaceArea"],{n,3,10}]

N[%]

FullSimplify[(1/4) n ((Csc[(π/(2 n))])^2) (Sqrt[(((3-2 Cos[(π/n)]))/(1+2 Cos[(π/n)]))])(1+2 Cos[(π/n)])]

FullSimplify[((n (Sqrt[(3-2 Cos[(π/n)])(1+2 Cos[(π/n)])]) ((Csc[(π/(2 n))])^2))/(4 ))]

Table[(1/4) n (Sqrt[1+4 Cos[(π/n)]-2 Cos[((2 π)/n)]]) ((Csc[(π/(2 n))])^2),{n,3,6}]//FullSimplify

N[%]

VertexCount

Table[PolyhedronData[{"Trapezohedron",n},"VertexCount"],{n,3,10}]

Table[2(n+1),{n,3,10}]

Volume

Table[PolyhedronData[{"Trapezohedron",n},"Volume"],{n,3,10}]

FullSimplify[((n Cot[(π/(2 n))] ((Csc[(π/(2 n))])^2))/(24 (Sqrt[2]) (Sqrt[1+Cos[(π/n)]]) (Sqrt[1+2 Cos[(π/n)]])))(((1+2 Cos[(π/n)]))^(3/2))]

Table[((n (1+2 Cos[(π/n)]) Cot[(π/(2 n))] ((Csc[(π/(2 n))])^2))/(24 (Sqrt[2]) (Sqrt[1+Cos[(π/n)]]))),{n,3,6}]//FullSimplify

Properties: {"Trapezohedron", 4}

p=PolyhedronData[pname={"Trapezohedron",4},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

(xbar=PolyhedronCentroid[p])//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]//Timing

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

PolyhedronEdgeLengths[p]//FullSimplify//Tally

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p])/vol))//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]//RootReduce//Timing

ToRadicals[(NumericalApproximation[Root, (RowDefault["0.806", FEExpressionsNumericalApproximationElider]), Root[-1-144 ((#1)^2)+224 ((#1)^4)&,2], ])]//FullSimplify

(Sqrt[(9/28)+(13/(28 (Sqrt[2])))])//N

Graphics3D[{Opacity[.4],Red,p,Yellow,Sphere[{0,0,0},(NumericalApproximation[Root, (RowDefault["0.806", FEExpressionsNumericalApproximationElider]), Root[-1-144 ((#1)^2)+224 ((#1)^4)&,2], ])]},Boxed->False]

MyInsphere[p//N]//Timing

MyInsphere[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

Midsphere

PolyhedronData[pname,"Midsphere"]

(midsphere=Midsphere[p//N])//Timing

((1/4 Csc[Pi/(2 n)])/(2-2 Cos[(π/n)]))/.n->4.

Graphics3D[{Opacity[.5],Red,p,Yellow,midsphere}]

(midsphere=Midsphere[p,Debug->True,"Simplification"->FullSimplify])//Timing

(midsphere=Midsphere[p,"SolveMethod"->"NSolve",WorkingPrecision->200])//Timing

midsphere[[2]]//ToAlgebraicRoot//ToRadicals//FullSimplify

Graphics3D[{Opacity[.5],Yellow,midsphere,Red,p},Boxed->False]

Polyhedron

Graphics3D[{Opacity[.5],PolyhedronData[pname,"Polyhedron"]},Boxed->False]

RegionFunction

FullSimplify[PolyhedronInequalities[p,{x,y,z}]]//Timing

(ineq=FullSimplify[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

PolyhedronSurfaceArea[p]//RootReduce//ToRadicals//FullSimplify//Timing

SurfaceArea[p]//FullSimplify

Volume

vol=PolyhedronData[pname,"Volume"]

PolyhedronVolume[p]//RootReduce

ToRadicals[%]//FullSimplify

Volume[p]//FullSimplify

Properties: {"Trapezohedron", 5}

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Trapezohedron",5},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify//Timing

(xbar=PolyhedronCentroid[p])//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]//Timing

DihedralAngles

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->ToAlgebraicRoot]//Quiet]//FullSimplify

Tally[%]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

PolyhedronEdgeLengths[p]//FullSimplify//Tally

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

%//ToRadicals//Simplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p])/vol))//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]//RootReduce//Timing

ToRadicals[(NumericalApproximation[Root, (RowDefault["0.806", FEExpressionsNumericalApproximationElider]), Root[-1-144 ((#1)^2)+224 ((#1)^4)&,2], ])]//FullSimplify

(Sqrt[(9/28)+(13/(28 (Sqrt[2])))])//N

Graphics3D[{Opacity[.4],Red,p,Yellow,Sphere[{0,0,0},(NumericalApproximation[Root, (RowDefault["0.806", FEExpressionsNumericalApproximationElider]), Root[-1-144 ((#1)^2)+224 ((#1)^4)&,2], ])]},Boxed->False]

MyInsphere[p//N]//Timing

MyInsphere[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

Midsphere

PolyhedronData[pname,"Midsphere"]

(midsphere=Midsphere[p//N])//Timing

Graphics3D[{Opacity[.5],Red,p,Yellow,midsphere}]

(midsphere=Midsphere[p,Debug->True,"Simplification"->FullSimplify])//Timing

(midsphere=Midsphere[p,"SolveMethod"->"NSolve",WorkingPrecision->200])//Timing

midsphere[[2]]//ToAlgebraicRoot//ToRadicals//FullSimplify

Graphics3D[{Opacity[.5],Yellow,midsphere,Red,p},Boxed->False]

Polyhedron

Graphics3D[{Opacity[.5],PolyhedronData[pname,"Polyhedron"]},Boxed->False]

RegionFunction

(ineq=FullSimplify[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

PolyhedronSurfaceArea[p]//RootReduce//ToRadicals//Simplify

SurfaceArea[p]//ToAlgebraicRoot//FullSimplify

Volume

vol=PolyhedronData[pname,"Volume"]

PolyhedronVolume[p]//RootReduce//FullSimplify

Volume[p]//FullSimplify

Properties: {"Trapezohedron", 6}

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Trapezohedron",6},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p])/vol))//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

RegionFunction

(ineq=FullSimplify[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

Properties: {"Trapezohedron", 7}

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Trapezohedron",7},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

DihedralAngles

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->ToAlgebraicRoot]//Quiet]//FullSimplify

Tally[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p])/vol))//Quiet//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Quiet//Timing

RootReduce[i2]//FullSimplify

N[%]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol))//Quiet//Timing

FullSimplify[ToAlgebraicRoot[rxy2]]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol))//Quiet//Timing

FullSimplify[ToAlgebraicRoot[rxyz2]]

RegionFunction

(ineq=FullSimplify/@Simplify/@RootReduce[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

ineq/.{x->#1,y->#2,z->#3}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

Properties: {"Trapezohedron", 8}

<<MathWorld`Polyhedra`

<<MathWorld`Graphs`

p=PolyhedronData[pname={"Trapezohedron",8},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

DihedralAngles

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->ToAlgebraicRoot]//Quiet]//FullSimplify

Tally[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p])/vol))//Quiet//Timing

i1//FullSimplify//Timing

N[ni=PolyhedronInertiaTensor[N[p,10000],vol,Identity,Identity]]//Quiet//Timing

(ni2=Map[ToAlgebraicRoot,ni,{2}])//Timing

(i2=PolyhedronInertiaTensor[p,vol,RootReduce,RootReduce])//Quiet//Timing

(i2=PolyhedronInertiaTensor[p,vol,Identity,Identity])//Quiet//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol))//Timing

ToAlgebraicRoot[rxy2]//FullSimplify

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol))//Quiet//Timing

ToAlgebraicRoot[rxyz2]//FullSimplify

RegionFunction

(ineq=FullSimplify/@Simplify/@RootReduce[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

ineq/.{x->#1,y->#2,z->#3}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

Properties: {"Trapezohedron", 9}

<<MathWorld`Polyhedra`

<<MathWorld`Graphs`

p=PolyhedronData[pname={"Trapezohedron",9},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

DihedralAngles

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->ToAlgebraicRoot]//Quiet]//FullSimplify

Tally[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p//N])/vol)//Quiet//Timing

(i1=((MomentOfInertia[p])/vol))//Quiet//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p,vol,Identity,Identity])//Quiet//Timing

(i22=Map[ToAlgebraicRoot,i2,{2}])//Quiet//Timing

N[i22]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol))//Quiet//Timing

ToAlgebraicRoot[rxy2]//FullSimplify

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol))//Quiet//Timing

ToAlgebraicRoot[rxyz2]//FullSimplify

RegionFunction

(ineq=FullSimplify/@Simplify/@RootReduce[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

ineq/.{x->#1,y->#2,z->#3}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

Properties: {"Trapezohedron", 10}

<<MathWorld`Graphs`

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Trapezohedron",10},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

DihedralAngles

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->ToAlgebraicRoot]//Quiet]//FullSimplify

Tally[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p//N])/vol)//Quiet//Chop//Timing

(i1=((MomentOfInertia[p])/vol))//Quiet//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p,vol,Identity,Identity])//Quiet//Timing

N[ni=PolyhedronInertiaTensor[N[p,10000],vol,Identity,Identity]]//Quiet//Timing

(ni2=Map[ToAlgebraicRoot,ni,{2}])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol))//Quiet//Timing

ToAlgebraicRoot[rxy2]//FullSimplify

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

((NIntegrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//Quiet//Timing

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol))//Quiet//Timing

ToAlgebraicRoot[rxyz2]//FullSimplify

N[%12]

RegionFunction

(ineq=FullSimplify/@Simplify/@RootReduce[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

ineq/.{x->#1,y->#2,z->#3}

Skeleton

PolyhedronData[pname,"Skeleton"]

RecognizeGraph[%]

Construction

Canonical

<<MathWorld`Polyhedra`

poly=FindCanonicalPolyhedron[Trapezohedron[4,40Degree]]

va=PolyhedronData[{"Antiprism",4},"Vertices"];
vt=PolyhedronCoordinates[poly];

Graphics3D[{{Opacity[.5],Red,poly,Yellow,Sphere[],Green,PolyhedronData[{"Antiprism",4},"Polyhedron"]/.Polyhedron[v_,f_]:>Polyhedron[1.6v,f]},
Text[Subscript[t,1],1.6va[[7]],Background->White],
Text[Subscript[t,2],1.6va[[3]],Background->White],
Text[Subscript[t,3],1.6va[[8]],Background->White],
Text[Subscript[b,1],1.6va[[1]],Background->White],
Text[Subscript[b,2],1.6va[[5]],Background->White],
Text["up",vt[[7]],Background->White],
Text["down",vt[[3]],Background->White],
Text["up2",vt[[9]],Background->White]
},Boxed->False]

h=(1/2)(Sqrt[1-(1/4)((Sec[(π/(2n))])^2)]);
R=(1/2)Csc[(Pi/n)];
t1={R,0,h};
t2={R Cos[((2π)/n)],R Sin[((2π)/n)],h};
t3={R Cos[((4π)/n)],R Sin[((4π)/n)],h};
b1={R Cos[(π/n)],R Sin[(π/n)],-h};
b2={R Cos[((3π)/n)],R Sin[((3π)/n)],-h};
uptip=x Mean[{t1,t2,b1}]//FullSimplify;
uptip2=x Mean[{t2,b2,t3}]//FullSimplify;
top={0,0,z};
downtip=x Mean[{b1,t2,b2}]//FullSimplify;
soln={x->(3/(1+2 Cos[(π/n)])),z->(1/4) Cos[(π/(2 n))] Cot[(π/(2 n))] Csc[((3 π)/(2 n))] (Sqrt[4-((Sec[(π/(2 n))])^2)])};

EdgeLengths

SquaredEuclideanDistance[t1,t2]/.Abs->Identity//FullSimplify

SquaredEuclideanDistance[b1,b2]/.Abs->Identity//FullSimplify

SquaredEuclideanDistance[b1,t2]/.Abs->Identity//FullSimplify

Edge of trapezohedron is perpendicular to edge of antiprism:

Dot[uptip-top,t1-t2]//FullSimplify

Intersecting edges of trapezohedron and antiprism are coplanar:

eqn1=Det[Append[#,1]&/@{uptip,top,t1,t2}]==0//FullSimplify

Antiprism top edge-trapezohedron long edge distance is 0:

https://mathworld.wolfram.com/Line-LineDistance.html

Dot[t1-uptip,Cross[top-uptip,t2-t1]]==0//FullSimplify

Antiprism slant edge-trapezohedron short edge distance is 0:

eqn2=Det[Append[#,1]&/@{uptip,downtip,b1,t2}]==0//FullSimplify

Solve[{eqn1,eqn2},{x,z}]//FullSimplify

soln={x->(3/(1+2 Cos[(π/n)])),z->(1/4) Cos[(π/(2 n))] Cot[(π/(2 n))] Csc[((3 π)/(2 n))] (Sqrt[4-((Sec[(π/(2 n))])^2)])};

centers=(3/(1+2 Cos[(π/n)]))Mean/@(Drop[PolyhedronData[{"Antiprism",4},"Polygons"],2][[All,1]]);

tips={0,0,# (1/4) Cos[(π/(2 n))] Cot[(π/(2 n))] Csc[((3 π)/(2 n))] (Sqrt[4-((Sec[(π/(2 n))])^2)])}&/@{-1,1};

Graphic

Graphics3D[{Opacity[.5],
Yellow,PolyhedronData[{"Antiprism",4},"Polyhedron"],
Red,ConvexHullRegion[Join[centers,tips]/.n->4]}]

Height Ratio

FullSimplify[(((1/4) Cos[(π/(2 n))] Cot[(π/(2 n))] Csc[((3 π)/(2 n))] (Sqrt[4-((Sec[(π/(2 n))])^2)]))/((1/2)Sqrt[1-Sec[Pi/(2 n)]^2/4]))]

Diagonal length

FullSimplify[EuclideanDistance[downtip,top]/.Abs->Identity/.soln]

FullSimplify[((Csc[(π/(2 n))])^2)(Sqrt[(((3-2 Cos[(π/n)]))/(16+32 Cos[(π/n)]))])]

Diagonal length/short edge length:

FullSimplify[(((1/4) (Sqrt[-1+(4/(1+2 Cos[(π/n)]))]) ((Csc[(π/(2 n))])^2))/(1/(Sqrt[1+2 Cos[(π/n)]])))]

Edge lengths

e2=FullSimplify[EuclideanDistance[uptip,top]/.soln/.Abs->Identity,n>0]

e2=(((Csc[(π/(2 n))])^2)/(4(Sqrt[1+2 Cos[(π/n)]])));

e1=FullSimplify[EuclideanDistance[uptip,downtip]/.soln/.Abs->Identity,n>0]

e1=(1/(Sqrt[1+2 Cos[(π/n)]]));

{e1,e2}/.n->4.

Edge length ratio:

FullSimplify[(e2/e1)]

(1/(2-2 Cos[(π/n)]))/.n->4.

Inradius

FullSimplify[With[{x0={0,0,0},x1=uptip,x2=downtip,x3=top},Normalize[Cross[x2-x1,x3-x1]].(x0-x1)/.soln]/.Abs->Identity]

FullSimplify[(((Sqrt[(((3-2 Cos[(π/n)]) )/(1+2 Cos[(π/n)]))]) (Sqrt[4-((Sec[(π/(2 n))])^2)]) Sin[(π/n)])/(-24+16 Cos[(π/n)]))((Csc[(π/(2 n))])^2)]

Midradius

FullSimplify[Norm[Mean[{t1,t2}]]/.Abs->Identity]

Polygon (kite)

Table[Graphics3D[Polygon[{top,uptip,downtip,uptip2}/.soln]],{n,3,5}]

FullSimplify[ArcCos@Dot[Normalize[top-uptip],Normalize[downtip-uptip]]/.soln/.Abs->Identity,n>2]

FullSimplify[ArcCos@Dot[Normalize[uptip-downtip],Normalize[uptip2-downtip]]/.soln/.Abs->Identity,n>2]

FullSimplify[ArcCos@Dot[Normalize[top-uptip2],Normalize[downtip-uptip2]]/.soln/.Abs->Identity,n>2]

FullSimplify[ArcCos@Dot[Normalize[uptip-top],Normalize[uptip2-top]]/.soln/.Abs->Identity,n>2]

θ1=ArcCos[(1/2)-Cos[(π/n)]];
θ2=ArcCos[2-3 Cos[(π/n)]+3 Cos[((2 π)/n)]-Cos[((3 π)/n)]];

{θ1,θ2}/.n->3

Block[{n=4},Graphics[{FaceForm[LightYellow],EdgeForm[Black],
p=Polygon[{x1=Through[{Sin,Cos}[-θ1/2]],{0,0},x2=Through[{Sin,Cos}[θ1/2]],x3={0,Cos[θ1/2]+(1/(2-2 Cos[(π/n)]))Cos[θ2/2]}}
],FontSize->18,FontFamily->"Times",Black,
Text[Subscript[θ,1],{0,0},{0,-2}],Text[Subscript[θ,1],x1,{-3,-.5}],Text[Subscript[θ,1],x2,{3,-.5}],Text[Subscript[θ,2],x3,{-.3,3}]}]]

PolygonAngle[p]//N

PolygonAngle[Polygon[{top,uptip,downtip,uptip2}/.soln/.n->4.]]

SurfaceArea

FullSimplify[4n Area[Triangle[{uptip,downtip,top}]]/.soln]

(1/4) n ((Csc[(π/(2 n))])^2) (Sqrt[(((3-2 Cos[(π/n)]))/(1+2 Cos[(π/n)]))])

VertexCoordinates

Height of apex:

z/.soln

Height of rim:

uptip[[3]]/.soln//FullSimplify

Radius:

Norm[Most[uptip]]/.Abs->Identity/.soln//FullSimplify

(1/2) Csc[(π/n)]

Volume

FullSimplify[4n Volume[Tetrahedron[{{0,0,0},uptip,downtip,top}]]/.Abs->Identity/.soln]

From middle points

Antiprism2[n_Integer]:=Antiprism2[n,Sqrt[1-Sec[Pi/(2 n)]^2/4]]/;n>2

Antiprism2[n_Integer,h_,a_:1]:=Module[{v,top=Range[n],bot=Range[n+1,2 n],faces},v=Join[Through[{a Csc[Pi/n]/2 Cos[#]&,a Csc[Pi/n]/2 Sin[#]&,h/2&}[2 Pi #/n]]&/@Range[0,n-1],Through[{a Csc[Pi/n]/2 Cos[#]&,a Csc[Pi/n]/2 Sin[#]&,-h/2&}[2 Pi (#+1/2)/n]]&/@Range[0,n-1]];
faces=Join[{top},{Reverse[bot]},Append@@@Transpose[{Reverse/@Partition[top,2,1,1],bot}],Append@@@Transpose[{Partition[RotateRight[bot],2,1,1],top}]];
GraphicsComplex[v,Polygon[faces]]]/;n>2

Trapezohedron2[n_Integer]:=Module[{v,top=Range[n],bot=Range[n+1,2 n],faces,a=(1/2) Csc[(π/n)],h=((Sqrt[4-((Sec[(π/(2 n))])^2)])/(4+8 Cos[(π/n)])),z=(1/4) Cos[(π/(2 n))] Cot[(π/(2 n))] Csc[((3 π)/(2 n))] (Sqrt[4-((Sec[(π/(2 n))])^2)]),scale=(Sqrt[1+2 Cos[(π/n)]])},
v=scale Join[
Through[{a Cos[#]&,a Sin[#]&,h&}[2 Pi#/n]]&/@Range[0,n-1],Through[{a Cos[#]&,a Sin[#]&,-h&}[2 Pi(#+1/2)/n]]&/@Range[0,n-1],
{{0,0,z},{0,0,-z}}];
faces=Join[
{#1,2n+1,#2,#3}&@@@Append@@@Transpose[{Reverse/@Partition[top,2,1,1],bot}],{#1,2n+2,#2,#3}&@@@Append@@@Transpose[{Partition[RotateRight[bot],2,1,1],top}]];
GraphicsComplex[v,Polygon[faces]]]/;n>2

Graphics3D[{
Opacity[.8],
FaceForm[Green,Red],Trapezohedron2[5]
(*
Blue,Antiprism2[4]/.GraphicsComplex[v_,p_]:>GraphicsComplex[v 1/4 Csc[Pi/(2 n)]/.n->4,p]
*)
},Boxed->False]

Antiprism

anti=Antiprism2[4];

v=anti[[1]]

f=anti[[2,1]]

e=Union[Sort/@Join@@(Partition[#,2,1,1]&/@f)]

SquaredEuclideanDistance@@@(v[[#]]&/@e)//FullSimplify

Trapezohedron

trap=Trapezohedron2[5];

v=trap[[1]];

2v[[-2,-1]]//FullSimplify//N

(1/4) ((Csc[(π/(2 n))])^3) Sin[(π/n)]/.n->5//FullSimplify//N

f=trap[[2,1]]

e=Union[Sort/@Join@@(Partition[#,2,1,1]&/@f)]

SimplifyNumericallyDistinct[SquaredEuclideanDistance@@@(v[[#]]&/@e)]//Quiet//Union

Net construction

θ1=ArcCos[(1/2)-Cos[(π/n)]];
θ2=ArcCos[2-3 Cos[(π/n)]+3 Cos[((2 π)/n)]-Cos[((3 π)/n)]];
diag=(1/4) (Sqrt[1+2 Cos[(π/n)]]) (Sqrt[-1+(4/(1+2 Cos[(π/n)]))]) ((Csc[(π/(2 n))])^2);

{θ1,θ2}/.n->3

FullSimplify[diag/.n->4]

Norm[x3]//FullSimplify

Block[{n=4},Graphics[{FaceForm[LightYellow],EdgeForm[Black],
p=Polygon[{x1=Through[{Sin,Cos}[-θ1/2]],{0,0},x2=Through[{Sin,Cos}[θ1/2]],x3={0,Cos[θ1/2]+(1/(2-2 Cos[(π/n)]))Cos[θ2/2]}}
],FontSize->18,FontFamily->"Times",Black,
Text[Subscript[θ,1],{0,0},{0,-2}],Text[Subscript[θ,1],x1,{-3,-.5}],Text[Subscript[θ,1],x2,{3,-.5}],Text[Subscript[θ,2],x3,{-.3,3}]}]]

GraphicsGrid[Partition[Table[Graphics[{FaceForm[LightYellow],EdgeForm[Black],TrapezohedronNet[n]}],{n,3,8}],UpTo[3]]]

EdgeLengths

EuclideanDistance@@@Flatten[Cases[Normal[TrapezohedronNet[3]],Polygon[x_]:>Partition[x,2,1,1],Infinity],1]//Union

SimplifyNumericallyDistinct[SquaredEuclideanDistance@@@Flatten[Cases[Normal[TrapezohedronNet[4]],Polygon[x_]:>Partition[x,2,1,1],Infinity],1]//FullSimplify//Quiet]//Union//Timing

SimplifyNumericallyDistinct[SquaredEuclideanDistance@@@Flatten[Cases[Normal[TrapezohedronNet[5]],Polygon[x_]:>Partition[x,2,1,1],Infinity],1]//FullSimplify//Quiet]//Union//Timing

NetCoordinates

TrapezohedronNet[4][[1]]//TrigToExp//FullSimplify//Timing

TrapezohedronNet[5][[1]]//TrigToExp//FullSimplify//Timing

TrapezohedronNet[6][[1]]//TrigToExp//FullSimplify//Timing

Map[ToAlgebraicRoot,TrapezohedronNet[7][[1]],{2}]//FullSimplify//Quiet//Timing

Map[ToAlgebraicRoot,TrapezohedronNet[8][[1]],{2}]//FullSimplify//Quiet//Timing

Map[ToAlgebraicRoot,TrapezohedronNet[9][[1]],{2}]//FullSimplify//Quiet//Timing

Map[ToAlgebraicRoot,TrapezohedronNet[10][[1]],{2}]//FullSimplify//Quiet//Timing

PolyhedronData

file=OpenWrite["~/trap.m"]

Do[WriteString[file,PolyhedronDataString[Trapezohedron[n],
"StandardName"->{"Trapezohedron",n},
"Name"->ToString[n]<>"\[Hyphen]trapezohedron",
"Classes"->{"Canonical"},
Debug->True
]],{n,4,10}]

Close[file]