Cube Triangle Picking

Author

Eric W. Weisstein
September 6, 2005

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

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

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

Initialization

Monte Carlo

StandardDeviationOfMean[l_]:=Sqrt[Variance[l]/Length[l]]
StandardDeviationOfVariance[l_]:=Module[{n=Length[l]},
Sqrt[(n-1)^2/n^3(Plus@@((l-Mean[l])^4)/n)-(n-1)(n-3)Variance[l]^2/n^3]
]

Timing[tris=Table[Random[],{10^7},{3},{3}];]

areas=TriangleArea3D/@tris;//Timing

Partition[Through[{Mean,StandardDeviationOfMean,Variance,StandardDeviationOfVariance}[areas]],2]

<<Graphics`Graphics`

BarChart[Length/@Split[Ceiling[300Sort[areas]]],Ticks->None,BarEdges->None,BarSpacing->-.2,AxesLabel->TraditionalForm/@{A,P[A]}]

Area

area=TriangleArea3D[{{x1,y1,z1},{x2,y2,z2},{x3,y3,z3}}]

area=(1/2) √((((-x2 y1+x3 y1+x1 y2-x3 y2-x1 y3+x2 y3))^2)+(((x2 z1-x3 z1-x1 z2+x3 z2+x1 z3-x2 z3))^2)+(((-y2 z1+y3 z1+y1 z2-y3 z2-y1 z3+y2 z3))^2));

NIntegrate

v5.2

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1}]//Timing

...hangs...

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->QuasiMonteCarlo,MaxPoints->10^6,PrecisionGoal->3]//Timing

NIntegrate[Evaluate[TriangleArea3D[{{x1,y1,z1},{x2,y2,z2},{x3,y3,z3}}]],{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->QuasiMonteCarlo,MaxPoints->10^7,PrecisionGoal->4]//Timing

NIntegrate[Evaluate[TriangleArea3D[{{x1,y1,z1},{x2,y2,z2},{x3,y3,z3}}]],{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->QuasiMonteCarlo,MaxPoints->10^8,PrecisionGoal->4]//Timing

...very wrong...

v6

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1}]//Timing

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},PrecisionGoal->3]//Timing

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},PrecisionGoal->3,Method->{GlobalAdaptive,MaxNumberOfErrorIncreases->10^4}]//Timing

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->QuasiMonteCarlo,MaxPoints->10^6,PrecisionGoal->3]//Timing

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->AdaptiveQuasiMonteCarlo,MaxPoints->10^6,PrecisionGoal->3]//Timing

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->{SymbolicPreprocessing,Method->AdaptiveQuasiMonteCarlo},MaxPoints->10^6,PrecisionGoal->3]//Timing

NIntegrate[area,{x1,0,1},{x2,0,1},{x3,0,1},{y1,0,1},{y2,0,1},{y3,0,1},{z1,0,1},{z2,0,1},{z3,0,1},Method->{SymbolicPreprocessing,Method->AdaptiveQuasiMonteCarlo},MaxPoints->10^8,PrecisionGoal->4]//Timing

...very wrong...

Analytic

vars=Flatten[{{x1,y1,z1},{x2,y2,z2},{x3,y3,z3}}]

v6

(int1=Integrate[√((((-x2 y1+x3 y1+x1 y2-x3 y2-x1 y3+x2 y3))^2)+(((x2 z1-x3 z1-x1 z2+x3 z2+x1 z3-x2 z3))^2)+(((-y2 z1+y3 z1+y1 z2-y3 z2-y1 z3+y2 z3))^2)),{x1,0,1},Assumptions->(0<#<1&/@Rest[vars])]/2)//Timing

NIntegrate[Evaluate[int1],Evaluate[Sequence@@({#,0,1}&/@Rest[vars])],Method->QuasiMonteCarlo]//Timing

Simplify[int1,(0<#<1&/@Rest[vars])]

(i1=Integrate[√((((-x2 y1+x3 y1+x1 y2-x3 y2-x1 y3+x2 y3))^2)+(((x2 z1-x3 z1-x1 z2+x3 z2+x1 z3-x2 z3))^2)+(((-y2 z1+y3 z1+y1 z2-y3 z2-y1 z3+y2 z3))^2)),x1]/2)//Timing

(int1=Simplify[Limit[i1,x1->1,Direction->1]-Limit[i1,x1->0,Direction->-1],(0<#<1&/@Rest[vars])])//Timing

NIntegrate[Evaluate[int1],Evaluate[Sequence@@({#,0,1}&/@Rest[vars])],Method->QuasiMonteCarlo]//Timing

(i2=Integrate[int1,x2])//Timing

Probability of Being Obtuse

tris2d=Triangle@@@Polygon2D/@tris;//Timing

{Length[tris2d],N[Count[tris2d,_?ObtuseQ]/Length[tris2d],10]//Timing}