How to solve a non-linear equation?

Question

I am trying to solve the following non-linear equation:

$\frac{i e^{-x^2} \sqrt{\pi } x}{K^2}+\left(-0.131251-0.0379031 x^2-0.0151154 x^4-0.0100462 x^6+0.5 \left(0.00273859 +0.0400003 K^2\right) x^8+(0. +0.0000362178 i) x^9+0.5 \left(\text{6.72230790401107$\grave{ }$*${}^{\wedge}$-6}+0.000122761 K^2\right) x^{10}+(0. +\text{7.371834962565406$\grave{ }$*${}^{\wedge}$-8} i) x^{11}+0.5 \left(\text{3.049800199384706$\grave{ }$*${}^{\wedge}$-9}+\text{7.195529551699709$\grave{ }$*${}^{\wedge}$-8} K^2\right) x^{12}+(0. +\text{3.611964212904051$\grave{ }$*${}^{\wedge}$-11} i) x^{13}+0.5 \left(-\text{1.2612171276659422$\grave{ }$*${}^{\wedge}$-12}-\text{1.7472476684229308$\grave{ }$*${}^{\wedge}$-11} K^2\right) x^{14}+\text{2.7423509229173302$\grave{ }$*${}^{\wedge}$-15} K^2 x^{16}\right)/\left(0.0200001 K^2 x^8+0.0000613803 K^2 x^{10}+\text{3.5977647758498545$\grave{ }$*${}^{\wedge}$-8} K^2 x^{12}-\text{8.736238342114654$\grave{ }$*${}^{\wedge}$-12} K^2 x^{14}+\text{2.7423509229173302$\grave{ }$*${}^{\wedge}$-15} K^2 x^{16}\right)$

Here's the Mathematica code I used:

Solve[(I E^-x^2 Sqrt[\[Pi]] x)/
    k^2 + (-0.13125090233975123 - 0.037903065816010294 x^2 - 
      0.015115427229185784 x^4 - 0.010046171350985062 x^6 + 
      0.5 (0.0027385850487922922 + 
         0.04000027499878133 k^2) x^8 + (0. + 
         0.000036217780642055754 I) x^9 + 
      0.5 (6.72230790401107*10^-6 + 
         0.00012276053475132815 k^2) x^10 + (0. + 
         7.371834962565406*10^-8 I) x^11 + 
      0.5 (3.049800199384706*10^-9 + 
         7.195529551699709*10^-8 k^2) x^12 + (0. + 
         3.611964212904051*10^-11 I) x^13 + 
      0.5 (-1.2612171276659422*10^-12 - 
         1.7472476684229308*10^-11 k^2) x^14 + 
      2.7423509229173302*10^-15 k^2 x^16)/(0.020000137499390665 k^2 x^8 + 
         0.00006138026737566407 k^2 x^10 + 
      3.5977647758498545*10^-8 k^2 x^12 - 
      8.736238342114654*10^-12 k^2 x^14 + 
      2.7423509229173302*10^-15 k^2 x^16) == 0, x]

where x is a complex variable and k is a real one.

I get this error message:

Solve::nsmet : This system cannot be solved with the methods available to Solve. >>

Please, I need to find x in terms of k and plot the output x versus k.

How can I use Mathematica techniques to solve this equation?

Answer 1

I believe the OP's equation has infinitely many solutions x for a given k. That might pose some difficulty. It does for giving a definitive answer.

From Plotting implicitly-defined space curves, you can find ways to plot the solutions. The method below follows this answer by Szabolcs. The way that the linked question applies to the OP's case is this: The complex equation eqn == 0 corresponds to two real equations Re@eqn == Im@eqn == 0; further, if we write x = re + im I in terms of its real and imaginary parts, we turn the equation into a pair equations in terms of three real variables {re, im, k}.

The variable eqn represents the left-hand side of the OP's equation. I got rid of the denominators (eqn1) because they led to divide-by-zero errors that broke lines.

Clear[re, im, x];
eqn1 = Numerator @ Simplify[Expand @ First @ eqn] == 0;
mfRe = Function[{re, im, k},  Re @ First @ eqn1 /. x -> re + im I // Evaluate ];

plot = ContourPlot3D[
 0 == Im@First@eqn1 /. x -> re + im I // Evaluate,
 {re, -3, 3}, {im, -3, 3}, {k, -1, 1},
 Mesh -> {{0}}, MeshFunctions -> {mfRe},
 ContourStyle -> None, BoundaryStyle -> None, AxesLabel -> Automatic,
 MeshStyle -> {Red, Thick}]

Some of the lines look broken. One could increase PlotPoints or MaxRecursion to see if ContourPlot can connect them up.

We can extract the lines and convert them to solutions, somewhat like this answer to Getting an InterpolatingFunction from a ContourPlot:

sols = With[{pts = First@Cases[plot, GraphicsComplex[pp_, ___] :> pp, Infinity]},
   pts[[#]] & /@ Cases[plot, Line[p_] :> p, Infinity]
   ];

We'll see which curve is the first Line in the plot:

With[{line1 = First[sols]},
  sol1 = Interpolation[
    Transpose@{line1[[All, 3]], line1[[All, {1, 2}]]}]
  ]; 

ParametricPlot3D[Join[sol1[k], {k}], 
 Evaluate[Prepend[First@sol1["Domain"], k]], 
 PlotRange -> {{-3, 3}, {-3, 3}, {-1, 1}}, BoxRatios -> {1, 1, 1}, 
 AxesLabel -> {re, im, k}] 

The function sol1 represents an approximate solution, but not a very good one (for an exact answer, First@eqn would evaluate to zero):

sol1[0.5].{1, I}
First@eqn /. {x -> sol1[0.5].{1, I}, k -> 0.5}
(* 1.30297 - 0.652346 I *)
(* -0.00599196 - 0.00566206 I *)

If a more accurate result is desired, one may apply FindRoot to each point:

With[{line1 = First[sols]},
  sol2 = Interpolation[
    {#[[3]], x /. FindRoot[
         First@eqn1 /. k -> #[[3]], {x, #[[{1, 2}]].{1, I}}]} & /@ line1]
  ]; 

First@eqn /. {x -> sol2[0.5], k -> 0.5}
(* -8.76055*10^-12 + 6.38489*10^-13 I *)