# Inverse of a complicated function

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.

-
You could help things a bit by giving Solve[Cos[s] == (* stuff inside the ArcCos[] *), r], but that yields a bunch of Root[] objects, and you need to pick which solution is appropriate... – J. M. Jun 21 '12 at 23:46
When I plot f[s], I see that the inverse of the function should increase from fmin~.19 to fmax~.602 as s varies from 0 to Pi. When plotting any of the Root[] functions over the interval (0,Pi) I find that they all have the same value at 0 and Pi. – Tuckerman Jun 22 '12 at 0:06
You have to track the root crossings carefully: interesting things happen at $\pi/2$ and $3\pi/2$! E.g., g = Solve[ Cos[s] == (-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))], r]; Show[Plot[r /. g[[3]], {s, 0, \[Pi]/2}, PlotRange -> {{0, \[Pi]}, {0.15, 0.65}}], Plot[r /. g[[4]], {s, \[Pi]/2, \[Pi]}]] – whuber Jun 22 '12 at 3:37

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]


-
One could use ParametricPlot[] to have a look at what the inverse might look like, too... – J. M. Jun 22 '12 at 0:48
@J.M. Absolutely, added, thanks. – Vitaliy Kaurov Jun 22 '12 at 0:55
@J.M. Or a semi-transparent glass – Dr. belisarius Jun 22 '12 at 1:36
@bel: I use acetate sheets myself, but that works too... – J. M. Jun 22 '12 at 1:37

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.

-