CODEWITHSUNDEEP
wolfram-mathematica
Ama
Ama

Reputation: 11

Solve complicated equation in Mathematica

I have a complicated equation and I wanna solve it with Mathematica. But, Because of the equation form I can't find analytical solution. So I try to solve it numerically. I try some method but can't find answer. I hope someone can help me. All parameter rather than s and z are the constant. I need find and after that plot log[z] over changing s.


    Clear[d, A, p, q, z, s]
    A = 1.5;
    p = 0.5;
    q = 0.1;
    d = 1;
    f[s_] := 
     FindInstance[
      1 + 1/((1 + d)^2 z^2 (-1 + p + q + 
            z)) ((1 + d) p (-1 + p + q) z Hypergeometric2F1[1, 
             2 + d + A Tanh[s], 2 + d, (p Cosh[s])/
             z] ((1 + d) Cosh[s] + A Sinh[s]) + 
           1/2 q Hypergeometric2F1[1, 2 + d - A Tanh[s], 2 + d, (
             q Cosh[s])/
             z] (p (-1 + p + q - 
                 z) (A^2 + (1 + d)^2 + (-A^2 + (1 + d)^2) Cosh[
                   2 s]) Hypergeometric2F1[1, 2 + d + A Tanh[s], 2 + d, (
                p Cosh[s])/z] + 
              2 (1 + d) (-1 + p + q) z (Cosh[s] + d Cosh[s] - 
                 A Sinh[s]))) == 0, z]
     \[Lambda] = Table[Flatten[{s, f[s]}], {s, -2, 2, 0.01}]
     ListPlot[\[Lambda]]

Upvotes: -1

Views: 95

Answers (1)

Ramashalanka
Ramashalanka

Reputation: 8864

First I define your function of s and z (using your values of A, p, q, d):

g[s_, z_] := 
 1 + 1/((1 + d)^2 z^2 (-1 + p + q + z)) ((1 + d) p (-1 + p + 
        q) z Hypergeometric2F1[1, 2 + d + A Tanh[s], 
       2 + d, (p Cosh[s])/z] ((1 + d) Cosh[s] + A Sinh[s]) + 
     1/2 q Hypergeometric2F1[1, 2 + d - A Tanh[s], 
       2 + d, (q Cosh[s])/
        z] (p (-1 + p + q - 
           z) (A^2 + (1 + d)^2 + (-A^2 + (1 + d)^2) Cosh[
             2 s]) Hypergeometric2F1[1, 2 + d + A Tanh[s], 
          2 + d, (p Cosh[s])/z] + 
        2 (1 + d) (-1 + p + q) z (Cosh[s] + d Cosh[s] - A Sinh[s])))

By plotting this function for a few values of s we see that it has several zeros and often an imaginary part (I checked that no zeros occur for |z|>5 for |s|<=2):

Table[Plot[{Re[g[s, z]], Im[g[s, z]]}, {z, -5, 5}, PlotLabel -> s], {s, -2, 2}]

g

However, the largest zero seems also have zero imaginary part (we confirm this below). We could look for zeros of the magnitude, but zeros of the absolute value are harder to find numerically.

To find the zeros of the real part, I define

f[s_] := z /. FindRoot[Re[g[s, z]] == 0, {z, (s + 1/2)^2/2.5 + 1}]

The quadratic function is just to get the initial condition for the root-find approximately correct. Now Plot[f[s], {s, -2, 2}] gives

f

I could also have used \[Lambda] = Table[{s, f[s]}, {s, -2, 2, .01}]; ListPlot[\[Lambda]] as you did for this step, if preferred.

Then I double check that both the real and imaginary parts are actually zero:

MapThread[Max, Table[Abs[{Re[g[s, f[s]]], Im[g[s, f[s]]]}], {s, -2, 2, .01}]]

{1.82077*10^-14, 0}

Upvotes: 0

Related Questions