Getting a series expansion for implicitly defined function

Question

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

Answer 1

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 + ...