Invert and fit implicitly defined curve

Question

I need to fit an implicitly defined curve. I thought I could get some data out of Solve, and then using FindFit.

Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$:

Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + 
(0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y]

But I can't get an output:

Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >>

Edit:

In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid, I would like it to fit to something like it.

What other strategies could I try?

Answer 1

You can get an approximation with NDSolve fairly easily for each of the four branches of the curve for which $y$ is a function of $x$. You can also get symbolic solutions in polar coordinates for each of the two branches for with $\theta$ is a function of $r$ (the reverse of the usual relationship sought).

First the polar:

eqOP = Rationalize[-(1/2) + 
     1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + 
      (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0,
   0];

tsol = Solve[
   eqOP /. {Sqrt[x^2 + y^2] -> r, 1/Sqrt[x^2 + y^2] -> 1/r} /. 
    x -> r Cos[t], t] /. C[1] -> 0

ParametricPlot[r {Cos[t], Sin[t]} /. tsol,
  {r, 0, x /. First@NSolve[0 < x < 4 && eqOP /. y -> 0, x]}]

wp = $MachinePrecision;
ics = {{1, y /. FindRoot[eqOP /. x -> 1, {y, 1.5}, WorkingPrecision -> wp]},
   {1, y /. FindRoot[eqOP /. x -> 1, {y, -1.5}, WorkingPrecision -> wp]},
   {x /. FindRoot[eqOP /. y -> 1/2, {x, -0.01}, WorkingPrecision -> wp], 1/2},
   {x /. FindRoot[eqOP /. y -> -1/2, {x, -0.01}, WorkingPrecision -> wp], -1/2}};
sols = Join @@ (NDSolve[{
        D[eqOP /. y -> y[x], x],
        y[First[#]] == Last[#]},
       y, {x, -1, 3},
       WorkingPrecision -> wp, PrecisionGoal -> 10, 
       AccuracyGoal -> 10, Method -> "ExplicitRungeKutta", 
       "ExtrapolationHandler" -> {Indeterminate &, 
         "WarningMessage" -> False}] & /@ ics);

(* many stiffness errors at the ends of the domains *)

Plot[y[x] /. sols // Evaluate, {x, -0.15, 2.65}]

If you really want to fit a formula, then there is data in the solutions that can be used. For instance

Transpose@Append[
  y["Coordinates"] /. First[sols],
  y["ValuesOnGrid"] /. First[sols]]

gives the $(x,y)$ pairs for the first solution. But perhaps the InterpolatingFunction is sufficient as is.