6
$\begingroup$

I have a set of parameters $x_1, \dots x_4 \in (0,1)$. I want to find the volume of the subregion of this 4d cube satisfying $$\sin^{-1}(x_1)+ \dots +\sin^{-1}(x_4) > \frac{3\pi}{2}$$

I've tried using a simple 

NIntegrate[ If[ArcSin[x1] + ArcSin[x2] + ArcSin[x3] + ArcSin[x4] > (3 Pi)/2, 1, 
  0], {x4, 0, 1}, {x3, 0, 1}, {x2, 0, 1}, {x1, 0, 1}]

However I get numerical lamentations. If I solve for one of the $x_i$ and put $x_i = \sin(\frac{3\pi}{2}-\sum_{j\neq i} \sin^{-1}{x_j})$ as a lower limit in its integral, I lose information by taking the sine ($\sin(x)$ is two-to-one for $x<2\pi$) and the $x_i$ integral can move beyond its range of validity.

Is there an elegant way to this without many If/else statements?

Improve this question
$\endgroup$
7
$\begingroup$ 
Clear["Global`*"]

Using If

vol1 = NIntegrate[
  If[ArcSin[x1] + ArcSin[x2] + ArcSin[x3] + ArcSin[x4] > 3 Pi/2, 1, 0], {x4, 
   0, 1}, {x3, 0, 1}, {x2, 0, 1}, {x1, 0, 1}, MinRecursion -> 9, 
  WorkingPrecision -> 20, 
  Method -> {"AdaptiveQuasiMonteCarlo", "RandomSeed" -> 1234}]

(* 0.00076851819200000000000 *)

Using Boole

vol2 = NIntegrate[
  Boole[ArcSin[x1] + ArcSin[x2] + ArcSin[x3] + ArcSin[x4] > 3 Pi/2], {x4, 0, 
   1}, {x3, 0, 1}, {x2, 0, 1}, {x1, 0, 1}, MinRecursion -> 9, 
  WorkingPrecision -> 20, 
  Method -> {"AdaptiveQuasiMonteCarlo", "RandomSeed" -> 1234}]

(* 0.00076851819200000000000 *)

Using Piecewise

vol3 = NIntegrate[
  Piecewise[{{1, 
     ArcSin[x1] + ArcSin[x2] + ArcSin[x3] + ArcSin[x4] > 3 Pi/2}}], {x4, 0, 
   1}, {x3, 0, 1}, {x2, 0, 1}, {x1, 0, 1}, MinRecursion -> 9, 
  WorkingPrecision -> 20, 
  Method -> {"AdaptiveQuasiMonteCarlo", "RandomSeed" -> 1234}]

(* 0.00076851819200000000000 *)

vol1 == vol2 == vol3

(* True *)
Improve this answer
$\endgroup$
10
  • $\begingroup$ Why the difference? The code m[t_] := RegionMeasure[ ImplicitRegion[ ArcSin[x1] + ArcSin[x2] + ArcSin[x3] + ArcSin[t] - (3*Pi)/2 >= 0 && x1 >= 0 && x1 <= 1 && x2 >= 0 && x2 <= 1 && x3 >= 0 && x3 <= 1, {x1, x2, x3}]]; NIntegrate[Evaluate[m[t]], {t, 0, 1}, AccuracyGoal -> 5, PrecisionGoal -> 5, WorkingPrecision -> 12] performs $0.000835762369747 $. $\endgroup$ – user64494 Feb 21 '20 at 19:38
  • $\begingroup$ @user64494 - I cannot reproduce your results. Running your code causes my kernel to quit. I am running version 12.0 on a Mac. $\endgroup$ – Bob Hanlon Feb 21 '20 at 20:14
  • $\begingroup$ @BobHanlon Very interesting solution ideas! I tried to give another solution way using RegionMeasure: reg = ImplicitRegion[ ArcSin[x4] + ArcSin[x3] + ArcSin[x2] + ArcSin[x1] > (3 \[Pi])/2 && 0 <= x4 <= 1 && 0 <= x3 <= 1 && 0 <= x2 <= 1 && 0 <= x1 <= 1, {x4, x3, x2, x1}], RegionMeasure[reg] but it doesn't evaluate. Any idea why not? $\endgroup$ – Ulrich Neumann Feb 21 '20 at 20:26
  • $\begingroup$ @Ulrich Neumann: So did I with the same result. After that I applied Cavalieri's principle. Now I tried to reproduce my result. $\endgroup$ – user64494 Feb 21 '20 at 20:40
  • $\begingroup$ @user64494 Mysterious! $\endgroup$ – Ulrich Neumann Feb 21 '20 at 20:47
0
$\begingroup$

Making use of Cavalieri's principle, one obtains

m[t_] := RegionMeasure[DiscretizeRegion[ImplicitRegion[ArcSin[x1] + ArcSin[x2] + ArcSin[x3] + ArcSin[t] - 
(3*Pi)/2 >= 0 &&
 x1 >= 0 && x1 <= 1 && x2 >= 0 && x2 <= 1 && x3 >= 0 && 
x3 <= 1, {x1, x2, x3}]]]
NIntegrate[Evaluate[m[t]], {t, 0, 1},AccuracyGoal -> 2,PrecisionGoal ->2, WorkingPrecision->12]//AbsoluteTiming

$ \{13.9241,0.000830119592627\}$

Improve this answer
$\endgroup$

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.