0
$\begingroup$

new to Mathematica. I am trying to approximate to ~30 decimal places $0<t<1$ satisfying $$\int_0^1 \frac{\sqrt{1-\sqrt x}}{\arctan(t + \arctan(x))} ~dx = \frac{\pi^2}{6}$$ I used the following code:

NSolve[Integrate[Sqrt[1 - Sqrt[x]]/ArcTan[t + ArcTan[x]], {x, 0, 1}] == Pi^2/6 && t > 0 && t < 1,t]

But the computation is taking very, very long. What am I doing wrong? How can I optimize this? A similar question has likely been asked before, but I do not know what to search for. Should I use NIntegrate, somehow?

Improve this question
$\endgroup$
6
$\begingroup$

Use FindRoot

Clear["Global`*"]

f[t_?NumericQ] := Module[{tt = SetPrecision[t, 30]},
  NIntegrate[Sqrt[1 - Sqrt[x]]/ArcTan[tt + ArcTan[x]], {x, 0, 1}, 
   WorkingPrecision -> 30]]

Plot the sides of the equation

Plot[{f[t], Pi^2/6}, {t, 0, 1},
 WorkingPrecision -> 30,
 PlotLegends -> Placed["Expressions", {.5, .7}]]

enter image description here

sol1 = FindRoot[f[t] == Pi^2/6, {t, 3/25}, WorkingPrecision -> 30]

(* {t -> 0.112689874579840073770094027065} *)

Verifying the solution

f[t] - Pi^2/6 /. sol1

(* 0.*10^-30 *)
Improve this answer
$\endgroup$
1
$\begingroup$

You can search it.

Select[Table[{t, 
NIntegrate[
 Sqrt[1. - Sqrt[x]]/ArcTan[t + ArcTan[x]], {x, 0, 1}]}, {t, 0, 1, 
0.001}], RealAbs[#[[2]] - Pi^2/6] < 0.01 &]

{{0.112, 1.64927}, {0.113, 1.643}, {0.114, 1.63679}}

so 0.112 ~ 0.114 is where the answer at.

With more search, you can get more precious answer.

Improve this answer
$\endgroup$
  • $\begingroup$ Thank you - how can I get the right-side elements of the list items to be more precise? That is, display more decimal places? $\endgroup$ – Descartes Before the Horse Jan 21 '20 at 5:01
  • 1
    $\begingroup$ @TheWheelisBeforeDescartes downstair gives out better solution. Back to my answer, to get preciser answer, you can replace {t, 0, 1, 0.001} with {t, 0.112, 0.114, 0.0001} and then set the <0.01& to < 0.001& . Or you can write other code to do this ,which is kind of trouble(not recommend). $\endgroup$ – wuyudi Jan 21 '20 at 5:34
1
$\begingroup$

another option is to find a function to fit the plot, then use Solve to find the root.

ClearAll[f, x, t];
f[t_?NumericQ] := NIntegrate[Sqrt[1 - Sqrt[x]]/ArcTan[t + ArcTan[x]], {x, 0, 1}]
Plot[f[t] - Pi^2/6, {t, 0, 1}]

Mathematica graphics

So your t is somewhere around 0.1. To find it, you could fit the curve to a function and then use Solve or root finding. For example

data=Catenate@Cases[Plot[f[t]-Pi^2/6,{t,0.1,0.2}],Line[data_]:>data,Infinity];
fit=Fit[data,{1,t,t^2,t^3,t^4},t]

Mathematica graphics

 Plot[fit, {t, 0.1, 0.2}, PlotRange -> All]

Mathematica graphics

Solve[fit == 0, t, Reals]

Mathematica graphics

or

 FindRoot[fit == 0, {t, 0.1}]

Mathematica graphics

Improve this answer
$\endgroup$
  • $\begingroup$ Would be hard to get 30 digits of accuraccy this way though. $\endgroup$ – mmeent Jan 22 '20 at 7:17

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.