Octahedron Tetrahedron Picking

Author

Eric W. Weisstein
September 6, 2005

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

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

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

Initialization

Octahedron of Unit Volume

ineq[{x_,y_,z_}]:=And@@PolyhedronInequalities[Polyhedron[Octahedron],{x,y,z}][[1]]

Integrate[Boole[ineq[{x,y,z}]],{x},{y},{z}]

Numerical Monte Carlo

Norm/@PolyhedronVertices[Octahedron]

((Sqrt[2]/3)/(Sqrt[2]^3))//N

(10^4)

Length[tet=Partition[Select[(Table[Random[Real],{10^4},{3}]-1/2)Sqrt[2],ineq],4]]//Timing

((Mean[Abs/@TetrahedronVolume/@tet])/((Sqrt[2])/3))

(10^5)

Length[tet=Partition[Select[(Table[Random[Real],{10^5},{3}]-1/2)Sqrt[2],ineq],4]]//Timing

((Mean[Abs/@TetrahedronVolume/@tet])/((Sqrt[2])/3))

(10^6)

Length[tet=Partition[Select[(Table[Random[Real],{10^6},{3}]-1/2)Sqrt[2],ineq],4]]//Timing

((Mean[Abs/@TetrahedronVolume/@tet])/((Sqrt[2])/3))

Symbolic Integration

Setup

vars=Array[x,{4,3}]

ineq[{x,y,z}]

ineqs=And@@(ineq/@vars);

vol=TetrahedronVolume[vars]

vol=(1/6) (-x[1,3] x[2,2] x[3,1]+x[1,2] x[2,3] x[3,1]+x[1,3] x[2,1] x[3,2]-x[1,1] x[2,3] x[3,2]-x[1,2] x[2,1] x[3,3]+x[1,1] x[2,2] x[3,3]+x[1,3] x[2,2] x[4,1]-x[1,2] x[2,3] x[4,1]-x[1,3] x[3,2] x[4,1]+x[2,3] x[3,2] x[4,1]+x[1,2] x[3,3] x[4,1]-x[2,2] x[3,3] x[4,1]-x[1,3] x[2,1] x[4,2]+x[1,1] x[2,3] x[4,2]+x[1,3] x[3,1] x[4,2]-x[2,3] x[3,1] x[4,2]-x[1,1] x[3,3] x[4,2]+x[2,1] x[3,3] x[4,2]+x[1,2] x[2,1] x[4,3]-x[1,1] x[2,2] x[4,3]-x[1,2] x[3,1] x[4,3]+x[2,2] x[3,1] x[4,3]+x[1,1] x[3,2] x[4,3]-x[2,1] x[3,2] x[4,3]);

Normalization

v5.0

<<Calculus`Integration`

Integrate[Boole[ineqs],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])]]//Timing

...hangs...

v5.2

Integrate[Boole[ineqs],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])]]//Timing

...hangs...

Integrate[Boole[ineqs],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])],GenerateConditions->True]//Timing

...hangs...

v6

Integrate[Boole[ineqs],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])]]//Timing

...hangs...

Integrate[Boole[ineqs],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])],GenerateConditions->True]//Timing

...hangs...

Numerical Integration

v5.0

<<Calculus`Integration`

((((3/(Sqrt[2]))))^4)NIntegrate[Boole[ineqs]Abs[vol],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])],Method->QuasiMonteCarlo]//Timing

...hangs...

v5.2

((((3/(Sqrt[2]))))^4)NIntegrate[Boole[ineqs]Abs[vol],Evaluate[Sequence@@(List/@Flatten[vars])],Method->MonteCarlo]//Timing

...hangs...

((((3/(Sqrt[2]))))^4)NIntegrate[Boole[ineqs]Abs[vol],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])],Method->QuasiMonteCarlo]//Timing

...hangs...

v6

((((3/(Sqrt[2]))))^4)NIntegrate[Boole[ineqs]Abs[vol],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])]]//Timing

...hangs...

((((3/(Sqrt[2]))))^4)NIntegrate[Boole[ineqs]Abs[vol],Evaluate[Sequence@@({#,-∞,∞}&/@Flatten[vars])],Method->AdaptiveQuasiMonteCarlo]//Timing

...hangs...