Inverse of a complicated function

Question

Mathematica is struggling to find the inverse of this function f(r):

f[r_]:=ArcCos[(-1 + 4.20278 r (0.008712/r^2 + 0.475876/r - 1/(1 + r)))/Sqrt[ 1 - 10.598 r^2 (0.008712/r^2 + 0.475876/r - 1/(1 + r))]]

If I attempt to use Solve or NSolve

(N)Solve[s==f[r],r]

mathematica just hangs up. The same is true for InverseFunction[].

I was wondering if there were any strategies to find the inverse of this function, even perhaps a numerical approximation. I have many functions like this and need to find their inverses.

Many thanks.

Answer 1

Well, numerical approach is at least straight forward, though maybe a bit tedious to make perfectly automated. Here is a crude start. I will deal only with real part of your function. Find the table of points and flip point pairs:

invf = Re@Table[{f[r], r}, {r, 0.001, 5, .01}];
gr = Show[ListLinePlot[invf, PlotStyle -> Red], 
 Plot[{r, Re@f[r]}, {r, 0, 5}], AspectRatio -> 1, 
 PlotRange -> {{0, 5}, {0, 5}}, Frame -> True, Axes -> False]

What follow is a bit manual. You see in this case you have 2 branches. Split your function for each of them. Of course this is just a start, you can explore further.

invff1[r_] := (Sort[Transpose[{Abs[#[[All, 1]] - r], #[[All, 2]]}]] &@
     Select[invf, #[[2]] < .8 &])[[1, 2]];
invff2[r_] := (Sort[Transpose[{Abs[#[[All, 1]] - r], #[[All, 2]]}]] &@
     Select[invf, #[[2]] > .8 &])[[1, 2]];

You have to be careful with ranges. Limit the ranges to what your data are well defined for and you basically got yourself an inverse function:

Manipulate[
 Show[gr, 
  Graphics[{Green, PointSize[.03], Point[{x, invff1[x]}], 
    Point[{x, invff2[x]}]}], PlotRange -> {{0, 4.5}, {0, 4.5}}]
 , {x, 0, 3}, FrameMargins -> 0]

Following @J.M. comment adding ParametricPlot[] way of looking at inverse:

Show[ParametricPlot[{f[r], r}, {r, 0.1, 5}, PlotStyle -> Green], 
 Plot[{r, f[r]}, {r, 0, 5}], AspectRatio -> 1, 
 PlotRange -> {{0, 5}, {0, 5}}, Frame -> True, Axes -> False, 
 GridLines -> Automatic, BaseStyle -> Thick]

Answer 2

On version 8.0.4 (Mac OS X 10.7.4) I can't reproduce the hanging problem right now. So I'll just post what I get in order to illustrate the point whuber was making in the comment about the switch between branches at $\pi/2$:

f[r_] := 
 ArcCos[(-1 + 4.20278 r (0.008712/r^2 + 0.475876/r - 1/(1 + r)))/
   Sqrt[1 - 10.598 r^2 (0.008712/r^2 + 0.475876/r - 1/(1 + r))]]

inv = InverseFunction[f]

InverseFunction::ifun: Inverse functions are being used. Values may be lost for multivalued inverses.

(*
==> Function[K$560, 
 Root[-9.980709009173207336338507314921*10^32 - 
    5.6513875402447117935217351899052*10^34 #1 + \
(-6.2538998570511812298820407237647*10^35 + 
       6.7574125679790639379694250000000*10^35 Cos[
         K$560]^2) #1^2 + (4.9434185675637107331456209245797*10^36 - 
       2.4031727155691592312030575000000*10^36 Cos[
         K$560]^2) #1^3 + (-7.6367044490503772137949618167113*10^36 + 
       1.0564173268177257812500000000000*10^36 Cos[K$560]^2) #1^4 + 
    4.1353312991847914062500000000000*10^36 Cos[K$560]^2 #1^5 &, 1]]
*)

Plot[f[inv[x]], {x, 0, Pi}, AspectRatio -> Automatic]

The plot should be a straight line along the diagonal if inv were the correct inverse. With Solve, you get all the branches and can stitch together the inverse over a larger interval. But with InverseFunction, we were warned and proceeded anyway, so it's no wonder that we get an inverse that's only valid up to $\pi/2$.

Possible things to try if the calculation hangs

Although I don't see any effect here, it sometimes helps to do Rationalize before applying symbolic manipulations: for example, you could try

f[r_] = 
 ArcCos[Rationalize[(-1 + 
       4.20278 r (0.008712/r^2 + 0.475876/r - 1/(1 + r)))/
     Sqrt[1 - 10.598 r^2 (0.008712/r^2 + 0.475876/r - 1/(1 + r))]]] //
   FullSimplify

Here I used = deliberately because I want the Rationalize and FullSimplify to be performed immediately.