3
$\begingroup$

The solid is defined by implicit function below:

$$\frac{51}{100} (\cos x \cos y+\cos x \cos z+\cos y \cos z)+\cos x+\cos y+\cos z+1\le0$$ where $x,y,z\in[0,2\pi]$

plot

I tried three different approaches with Mathematica to calculate the solid's volume:

  1. Monte Carlo :

    ClearAll["Global`*"]; n = 1025; SeedRandom[20170524];
    
    f[x_] := (Cos /@ x // Total) +  51/100*Dot[Cos /@ RotateRight @ x, Cos /@ x] + 1
    
    Count[Flatten @ (f /@ RandomReal[{0, 2 Pi}, {n, 3}]), u_ /; u <= 0]/
      n*(2.0 Pi)^3
    
  2. immediate integral over implicit region:

    NIntegrate[1, {x, y, z} ∈ 
    ImplicitRegion[ 1 + Cos[x] + Cos[y] + Cos[z] + 
        51/100 (Cos[x] Cos[y] + Cos[x] Cos[z] + Cos[y] Cos[z]) <= 0 && 
      0 <= x <= 2 Pi && 0 <= y <= 2 Pi && 0 <= z <= 2 Pi, {x, y, z}]]
    
  3. Boole integrand over cube

    NIntegrate[
     Boole[1 + Cos[x] + Cos[y] + Cos[z] + 
        51/100 (Cos[x] Cos[y] + Cos[x] Cos[z] + Cos[y] Cos[z]) <= 0], {x, 
      0, 2 Pi}, {y, 0, 2 Pi}, {z, 0, 2 Pi}, WorkingPrecision -> 50]
    

Different approaches lead to different results.

Which one is more reliable and why since it seems there is no closed form result for this problem? Is it possible to evaluate the volume of this solid at arbitrary precision with Mathematica?

$\endgroup$
  • $\begingroup$ Your code for 1. Monte Carlo doesn't return any value (it apparently just defines an f[x]). $\endgroup$ – QuantumDot May 24 '17 at 3:33
  • $\begingroup$ Is your second one copied correctly? Trying to run it in Mathematica gives me an error. The {x,y,z}[Element]Implicit... part looks incorrectly entered. $\endgroup$ – Ian Miller May 24 '17 at 3:34
  • $\begingroup$ @QuantumDot It does if you add in the missing newlines the OP left out with their copying. $\endgroup$ – Ian Miller May 24 '17 at 3:35
  • $\begingroup$ Updated. thanks $\endgroup$ – LCFactorization May 24 '17 at 4:08
  • 1
    $\begingroup$ Consider simplifying the problem by shifting and then treating just one octant: 8 NIntegrate[Boole[1 - Cos[x] - Cos[y] - Cos[z] + 51 (Cos[x] Cos[y] + Cos[x] Cos[z] + Cos[y] Cos[z])/100 <= 0], {x, 0, π}, {y, 0, π}, {z, 0, π}] $\endgroup$ – J. M. will be back soon May 24 '17 at 8:08
2
$\begingroup$

Use symmetry, as J.M. suggested, split up the region....after some work....

8 (NIntegrate[1,
    {x, 0, ArcCos[-(49/100)]},
    {y, ArcCos[-((49 Cos[x])/(49 + 51 Cos[x]))], Pi},
    {z,
     Piecewise[{{ArcCos[(-100 - 100 Cos[x] - 100 Cos[y] - 
          51 Cos[x] Cos[y])/(
         100 + 51 Cos[x] + 51 Cos[y])], -1 <= (-100 - 100 Cos[x] - 
          100 Cos[y] - 51 Cos[x] Cos[y])/(
         100 + 51 Cos[x] + 51 Cos[y]) <= 1}}, 0],
     Pi}
    ] +
   NIntegrate[1,
    {x, ArcCos[-(49/100)], Pi},
    {y, 0, ArcCos[(-200 - 151 Cos[x])/(151 + 51 Cos[x])]},
    {z,
     ArcCos[(-100 - 100 Cos[x] - 100 Cos[y] - 51 Cos[x] Cos[y])/(
      100 + 51 Cos[x] + 51 Cos[y])],
     Pi}
    ] +
   NIntegrate[1,
    {x, ArcCos[-(49/100)], Pi},
    {y, ArcCos[(-200 - 151 Cos[x])/(151 + 51 Cos[x])], Pi},
    {z, 0, Pi}
    ])

(*  67.5935  *)
$\endgroup$
  • $\begingroup$ Thank you. But can you also indicate the some work mentioned? :D $\endgroup$ – LCFactorization May 25 '17 at 0:21
  • 1
    $\begingroup$ @LCFactorization Solve for the intersections in terms of Cos[z], then Cos[y] to determine the boundaries of the integration regions. I used Solve, but Reduce[inequality, {Cos[x], Cos[y], Cos[z]}] might work. It looks a little different, but there's probably more than one way. $\endgroup$ – Michael E2 May 25 '17 at 1:07
  • 2
    $\begingroup$ Reduce[inequality && -1 < Cos[x] < 1 && -1 < Cos[y] < 1 && -1 < Cos[z] < 1, {Cos[x], Cos[y], Cos[z]}] give a better result for setting up the integrals. $\endgroup$ – Michael E2 May 25 '17 at 1:09
  • $\begingroup$ I tried to increase the WorkingPrecision, and still got warning message like The global error of the strategy GlobalAdaptive has increased more than 2000 times. So this does not seem like a method assure numerical robustness. Am I right? $\endgroup$ – LCFactorization May 25 '17 at 1:51
  • 2
    $\begingroup$ @LCFactorization Method -> {"GaussKronrodRule", "Points" -> 11}, WorkingPrecision -> 20 yields 67.59353836486477145961457284250657132954`20., which agrees with the machine precision result to about 8 digits. After several minutes, Method -> {"GaussKronrodRule", "Points" -> 21}, WorkingPrecision -> 24 yields 67.59353836486223222953151386376534048904`24., which agrees with the 20-digit result to 13 digits. The default method is much faster, but not as accurate. $\endgroup$ – Michael E2 May 25 '17 at 3:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.