Improve performance of evaluating over an implicit region

Question

Consider the following implicit region:

f[EX_, mX_, mY_, mM_] = 
  Sqrt[
    4 EX^2 mM^2 - mM^4 - 2 mM^2 mX^2 - mX^4 + 2 mM^2 mY^2 + 2 mX^2 mY^2 - mY^4] / 
  Sqrt[4 EX^2 mM^2 - 4 mM^2 mX^2];
cosαV[θX_, θM_, ϕM_] = Cos[ϕM]*Sin[θX] Sin[θM] + Cos[θX]*Cos[θM];
region[EX_, θX_, mX_, mY_, mM_] = 
  ImplicitRegion[
    Abs[cosαV[θX, θM, ϕM]] - f[EX, mX, mY, mM] > 0, 
    {{ϕM, 0, Pi}, {θM, 0, Pi}}]

Here, the parameters are

$ \qquad EX>mX>0, \quad 0<mY<mM, \quad mX < mM, \quad 0< \theta X < \pi $

The evaluation of the ImplicitRegion is very slow. The evaluation of the integral and region plot are taking a huge amount of time,

integral[EX_, θX_, mX_, mY_, mM_] := 
  NIntegrate[1, 
   {ϕM, θM} ∈ region[EX, θX, mX, mY, mM], 
   Method -> {Automatic}]

integral[10, 0.05, 0.5, 0.5, 5.279]
RegionPlot[region[10, 0.05, 0.5, 0.5, 5.279]]

These evaluations would require a much less time if the ImplicitRegion could be replaced by the explicit bounds (i.e., analytic functions depending on parameters).

Could you please tell me whether Mathematica is able to evaluate the explicit bounds?

P.S. It is in principle possible to derive the region analytically, but this would require a lot of working with expressions due to the periodicity of angular variables $\theta_{M},\phi_{M}$.

Answer 1

Clear["Global`*"]

You provide several constraints on the parameters but there is no indication that you made use of these constraints.

$Assumptions = EX > mX > 0 && 0 < mY < mM && mX < mM && 0 < θX < Pi;

Use Simplify in the definition of f

f[EX_, mX_, mY_, mM_] = 
  Sqrt[4 EX^2 mM^2 - mM^4 - 2 mM^2 mX^2 - mX^4 + 2 mM^2 mY^2 + 2 mX^2 mY^2 - 
      mY^4]/Sqrt[4 EX^2 mM^2 - 4 mM^2 mX^2] // Simplify;

cosαV[θX_, θM_, ϕM_] = 
  Cos[ϕM]*Sin[θX] Sin[θM] + Cos[θX]*Cos[θM];

region[EX_, θX_, mX_, mY_, mM_] = 
  ImplicitRegion[
   Abs[cosαV[θX, θM, ϕM]] - f[EX, mX, mY, mM] > 
    0, {{ϕM, 0, Pi}, {θM, 0, Pi}}];

integral[EX_, θX_, mX_, mY_, mM_] := 
 NIntegrate[1, {ϕM, θM} ∈ region[EX, θX, mX, mY, mM], 
  Method -> {Automatic}]

While not quick, the integral and the plot do not take a "huge amount of time."

integral[10, 0.05, 0.5, 0.5, 5.279] // AbsoluteTiming

(* {5.35521, 1.63462} *)

Alternatively, using RegionMeasure for the integral

RegionMeasure[region[10, 0.05, 0.5, 0.5, 5.279]] // AbsoluteTiming

(* {5.82893, 1.63462} *)

The results are the same

%[[-1]] == %%[[-1]]

(* True *)

RegionPlot[region[10, 0.05, 0.5, 0.5, 5.279], 
  ImageSize -> Medium] // AbsoluteTiming