# Getting a series expansion for implicitly defined function

I have a function $$f(r)$$ defined as $$x$$ satisfying $$g(r,x)=0$$.

How do I get a series expansion of $$f(r)$$ around $$r=\infty$$?

Function $$f(r)$$ below is unexpectedly linear, and I'm trying to get a closed form expression for exact values of slope and intercept

ClearAll["Globals*"];
g[r_, x_] =
Log[2 (-(E^x)^(-1/r) r + Zeta[1 + 1/r])^2 Zeta[2 (1 + 1/r)]] -
Log[Zeta[
1 + 1/r]^2 (-((E^x)^(1 - 2 (1 + 1/r))/(-1 + 2 (1 + 1/r))) +
Zeta[2 (1 + 1/r)])];
f[r_] := x /. FindRoot[g[r, x], {x, 1}];
Plot[f[r], {r, 1, 10}, AxesLabel -> {"r", "f(r)"}]


For a different $$f(r)$$ this kind of asymptotic inversion can be done using InverseSeries command, but here it returns unevaluated.

Background question on math.SE

• The answer is f[r_] = Log[2 + Sqrt[2]] r - EulerGamma + (EulerGamma^2/2 + StieltjesGamma[1])/r + (-2 EulerGamma^3 - 6 EulerGamma StieltjesGamma[1] - 3 StieltjesGamma[2])/(6 r^2) plus higher-order terms; but I have no idea how to do it in Mathematica in a concide way. May 24, 2023 at 19:06
• @Roman interesting! For $r\to \infty$, only the first two terms matter, how did you get them? May 24, 2023 at 20:14
• (1) Is the $g(x,z)$ in the edit at the top the same specific function in the previous question coded by g[x, z]? (Note AsymptoticSolve[] is the function that does what you ask in the edit, only it is not robust enough to handle all cases and not g[x, z] unfortunately. Probably nothing can handle all cases.) (2) A new question should not supersede an old Q&A but be posted as new question (unless the old Q&A didn't get any answers). May 25, 2023 at 23:16
• @MichaelE2 yes, it's the same, moved the edit into separate question here. Agreed on general intractability, but only special forms of $g$ in the new question are important to me May 26, 2023 at 0:14

Here's a step-by-step way to discover @Roman's first two terms:

g[r_, x_] =
Log[2 (-(E^x)^(-1/r) r + Zeta[1 + 1/r])^2 Zeta[2 (1 + 1/r)]] -
Log[Zeta[
1 + 1/r]^2 (-((E^x)^(1 - 2 (1 + 1/r))/(-1 + 2 (1 + 1/r))) +
Zeta[2 (1 + 1/r)])];


Dominant term: Use a graph to get rough idea. There seems to be a linear relationship between $$r=1/\rho$$ and $$x=1/\xi$$ at infinity:

ContourPlot[g[1/ρ, 1/ξ] == 0,
{ρ, 0, 1/10}, {ξ, 0, 1/10}]


Taking $$x=ur$$ as an ansatz, solve for $$u$$ at infinity:

Limit[g[r, u r], r -> Infinity, Assumptions -> u > 0]
Solve[% == 0 && u > 0, u]

Log[2 E^(-2 u) (-1 + E^u)^2]

{{u -> Log[2 + Sqrt[2]]}}


Constant term: Again let's graph using the dominant term plus a variable for the remainder:

ContourPlot[g[1/ρ, (Log[2 + Sqrt[2]])/ρ + ξ] == 0,
{ρ, 0, 1/10}, {ξ, -1, 1}]


The constant looks negative, around -0.57.... Let's solve for it at infinity:

Limit[g[r, (Log[2 + Sqrt[2]]) r - c] r, r -> Infinity,
Assumptions -> c > 0]
Solve[% == 0, c]
(*
2 (-1 + Sqrt[2]) (-c + EulerGamma)
{{c -> EulerGamma}}
*)


Putting it together,

x = (Log[2 + Sqrt[2]]) r - EulerGamma + ...

• Aha thanks. That seems like a lot of work though, I was wondering if there's a way to adjust the following command to make it work InverseSeries@Series[g[r, x], {r, \[Infinity], 1}] May 24, 2023 at 23:13
• That's exactly what I meant when I said that "I have no idea how to do it in Mathematica in a concise way." Ideally, AsymptoticSolve should do this very trick; but it doesn't. May 25, 2023 at 7:09
• @MichaelE2 Very interesting answer: Calculating the constant part , why did you take the limit g[r,...] *r (not only g[r,...]  ) ? Thanks May 25, 2023 at 15:47
• @UlrichNeumann The asymptotic expansion of g[r,x] should have the form a r + b + c/r + ..., and for the solution for x, the coefficients should vanish. When we substitute the partial expansion of the solution for x, the expansion of g should become 0*r + 0 + c1 / r + .... I wanted to recover the coefficient c1 and solve c1 == 0. Thus r * g[r,...] has the expansion c1 + d1/r + e1/r^2 +..., and the limit at infinity is c1`. May 25, 2023 at 15:56
• @MichaelE2 Clever, thanks. I tried unsuccesfully to evaluate the third term of the asymptotic expansion May 25, 2023 at 17:26