Issue in combining FindRoot and NIntegrate

Question

The following gives compile warnings and returns unevaluated, any idea why?

obj2[a_] := 
 NIntegrate[(
   E^(1/2 (-x[1]^2 - x[2]^2))
     Log[Abs[1 - a (x[1]^2 + x[2]^2)]] x[
     1]^2)/(\[Pi] (x[1]^2 + x[2]^2)), {x[
     1], -\[Infinity], \[Infinity]}, {x[
     2], -\[Infinity], \[Infinity]}] + Log[2]/2;
obj2[.915]   (* -0.00319086 + 5.42344*10^-18 I *)

FindRoot[obj2[a], {a, 0.92}]   (* compile errors + returns unevaluated *)

Also, I'm curious why the result of NIntegrate is complex, the only suspect part is Log[Abs[x]], but it should be real for all x.

(it's the objective from here)

Answer 1

The two problems seem to be related, or at least can be cured together:

obj2[a_?NumericQ] := 
  Chop[NIntegrate[(E^(1/2 (-x[1]^2 - x[2]^2)) Log[
         Abs[1 - a (x[1]^2 + x[2]^2)]] x[1]^2)/(\[Pi] (x[1]^2 + 
         x[2]^2)), {x[1], -\[Infinity], \[Infinity]}, {x[
       2], -\[Infinity], \[Infinity]}] + Log[2]/2];
obj2[.915]  (* -0.00319086 *)
FindRoot[obj2[a], {a, 0.92}]  (* {a -> 0.918611} *)

The two modifications are:

• Using a test to sanitize the inputs of obj2. Using the pattern a_?NumericQ inside a function definition means that the function will only be evaluated if NumericQ evaluates to True on an argument, and will be return unevaluated if it does not. In particular, this prevents FindRoot from trying to take symbolic derivatives of obj2 in its internal algorithms, which it will do by default.

• Chop removes "small" complex parts from numerical outputs. Like you, I'm unsure why NIntegrate is returning a complex part for this integrand at all; but it apparently causes FindRoot to invoke some kind of algorithm that does not converge. Making sure that obj2 only ever returns a real output makes FindRoot much happier.

Answer 2

Use the settings by @Akku14, we can find two roots in 0<a<1.

Clear[obj2]; 
obj2[a_?NumericQ] := 
 NIntegrate[(E^(1/2 (-x[1]^2 - x[2]^2)) Log[
       Abs[1 - a (x[1]^2 + x[2]^2)]] x[1]^2)/(π (x[1]^2 + 
        x[2]^2)), {x[1], -∞, ∞}, {x[
     2], -∞, ∞}, WorkingPrecision -> 15] + 
  Log[2]/2;
FindRoot[obj2[a], {a, 0.2}]

FindRoot[obj2[a], {a, 0.8}]

ReImPlot[obj2[a], {a, 0, 1}]

{a -> 0.121312}

{a -> 0.918611}