Tetrahedron Line Picking

Author

Eric W. Weisstein
September 26, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/TetrahedronLinePicking.nb.

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

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

Exact value

Dominik Beck.  "Mean distance in polyhedra."  https://arxiv.org/abs/2309.13177

Unit edge length

N[(1/(Sqrt[2]))(((Sqrt[2])/7)-((37π)/315)+(4/15)ArcTan[(Sqrt[2])]+((113Log[3])/(210(Sqrt[2])))),10]

Unit volume

A366019

N[(3^(1/3))(((Sqrt[2])/7)-((37π)/315)+(4/15)ArcTan[(Sqrt[2])]+((113Log[3])/(210(Sqrt[2])))),10]

Tetrahedron inequality

ineq[x_,y_,z_]:=And@@{x+y+z≤2 ,x-y-z≤0,-x+y-z≤0,-x-y+z≤0};

reg=ImplicitRegion[ineq[x,y,z],{x,y,z}]

RegionPlot3D[reg,PlotPoints->100,Axes->True]

Random line picking

Length[pts=Partition[Select[RandomReal[{0,1},{1*^7,3}],ineq@@#&],2]]//Timing

Length[lines=Partition[RandomPoint[reg,10^7],2]]//Timing

Graphics3D[{Red,Line/@Take[lines,1000]}]

Length[dist=Norm/@(Subtract@@@lines)]

(3^(1/3))Mean[dist]

Histogram[(3^(1/3))dist,{.01}]

Numeric integration

GlobalAdaptive

Machine-precision

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1}]//Timing

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},Method->{"GlobalAdaptive","MaxErrorIncreases"->5000}]//Timing

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},Method->{"GlobalAdaptive","MaxErrorIncreases"->1*^4}]//Timing

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},Method->{"GlobalAdaptive","MaxErrorIncreases"->1*^5}]//Timing

High-precision

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},WorkingPrecision->20]//Timing

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},WorkingPrecision->20,Method->{"GlobalAdaptive","MaxErrorIncreases"->5000}]//Timing

MonteCarlo

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},Method->{"MonteCarlo",MaxPoints->10^9}]

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},Method->{"QuasiMonteCarlo",MaxPoints->10^9}]

(3^(7/3))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],{x1,0,1},{y1,0,1},{z1,0,1},{x2,0,1},{y2,0,1},{z2,0,1},Method->{"AdaptiveQuasiMonteCarlo",MaxPoints->10^9}]

CAD

PolyhedronData["Tetrahedron"]

ineq1=PolyhedronData["Tetrahedron","RegionFunction"]

reg=And@@ineq1@@@{{x1,y1,z1},{z2,y2,z2}}

cad=CylindricalDecomposition[reg,{x1,y1,z1,z2,y2,z2},"Function"]

NIntegrate[(Sqrt[(((x1-x2))^2)+(((y1-y2))^2)+(((z1-z2))^2)])Boole[cad],{x1,y1,z1,x2,y2,z2}∈FullRegion[6],Method->{"AdaptiveQuasiMonteCarlo"}]

ineq=.

ineq[x_,y_,z_]:=And@@{x+y+z≤2 (3^(1/3)) ,x-y-z≤0,-x+y-z≤0,-x-y+z≤0}

Integrate[Boole[ineq[x,y,z]],{x,y,z}∈FullRegion[3]]

reg=ImplicitRegion[ineq[x,y,z],{x,y,z}]

RegionBounds[reg]