Integrating function over region is slow

Question

I have a function

f[pt_] := Log[1/(1 - Abs[x])] + Log[1/(1 - Abs[y])] /. {x -> pt[[1]], y -> pt[[2]]}

That looks like this:

I want to integrate it over a rotated rectangle:

Plot[NIntegrate[f[{x, y}], {x, y} \[Element] 
     TransformedRegion[Rectangle[{-1/2, -1/2}, {1/2, 1/2}], 
         RotationTransform[theta]]], {theta, 0, 2 Pi}]

But it's very slow, and I keep getting errors like:

NIntegrate::slwcon: Numerical integration converging too slowly;
suspect one of the following: singularity, value of the integration
is 0, highly oscillatory integrand, or WorkingPrecision too small.

I don't think this function should be that difficult to integrate.

I tried to rotate it myself like this:

r[t_] := {{Cos[t], -Sin[t]}, {Sin[t], Cos[t]}}
Plot[NIntegrate[f[r[theta].{x, y}], {x, -1/2, 1/2}, {y, -1/2, 1/2}], {theta, 0, 2 Pi}]

But it is still very slow. As in I had to kill it after multiple minutes of no results. I'm using Mathematica 12.1.1.0. Is there anything I can do to speed this up?

---

Bonus problem: I also want to find the maximum of the function. So I take

FindMaximum[{NIntegrate[f[r[theta].{x, y}], {x, y} \[Element] Rectangle[{-1/2, -1/2}, {1/2, 1/2}]], 0 <= theta <= 2 Pi}, {theta, .1}]

However, this gives me a bunch of errors like

NIntegrate::inumr: The integrand g[x Cos[theta]-y Sin[theta],
y Cos[theta]+x Sin[theta]] has evaluated to non-numerical values
for all sampling points in the region with boundaries
{{-(1/2),0.},{-(1/2),1/2}}.

I tried to change the definition of r to

r[t_?NumericQ] := {{Cos[t], -Sin[t]}, {Sin[t], Cos[t]}}

But it doesn't seem to improve things. It only changes the error to

NIntegrate::inumr: The integrand g[r[theta],{x,y}] has evaluated to
non-numerical values for all sampling points in the region with
boundaries {{-(1/2),1/2},{-(1/2),1/2}}.

Note that the function is definitely defined at this location, and for all valid points in the region for any rotation.

Can anyone help me understand what I'm doing wrong?

Answer 1

We can also fix the integral region but transform the function by RotationMatrix.

f[{x_, y_}] = Log[1/(1 - Abs[x])] + Log[1/(1 - Abs[y])];
Plot[NIntegrate[
  Evaluate[f[{x, y} . RotationMatrix[θ]]], {x, -1/2, 
   1/2}, {y, -1/2, 1/2}], {θ, 0, 2 π}]
int[θ_?NumericQ] := 
 NIntegrate[
  f[{x, y} . RotationMatrix[θ]] // Evaluate, {x, -1/2, 
   1/2}, {y, -1/2, 1/2}]
FindMaximum[{int[θ], 0 <= θ <= 2 π}, {θ, .1}]

{0.613705, {θ -> 0.00170899}}

Answer 2

$Version

(* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *)

Clear["Global`*"]

f[pt_] := Total[Log[1/(1 - Abs[#])] & /@ pt]

rgn[theta_] = 
  TransformedRegion[Rectangle[{-1/2, -1/2}, {1/2, 1/2}], 
    RotationTransform[theta]] // Simplify;

int[theta_?NumericQ] := 
 NIntegrate[f[{x, y}], {x, y} ∈ rgn[theta]]

Plot[int[theta], {theta, 0, 2 Pi}] // AbsoluteTiming

({max, arg} = FindMaximum[int[theta], {theta, 1.6}]) // AbsoluteTiming

(* {1.1356, {0.613706, {theta -> 1.57082}}} *)