Yeah, but what do you mean by
The transcendental complex equation is solved using Wolfram
Mathematica
There is no equation. You give only a definition of T. What is the condition? Re [ f [ En, Va ] ] == 0 or
Re [ f [ En, Va ] ] == Im [ f [ En, Va ] ] or something else? And what do the n 's signify in your table? Your problem is still not clear.
|
|
I have said that
I consider the definition of T to be a function of f[En_] , because
the value I want to find is the value of En
The initial condition is
f [ En, Va ] = Re [ f [ En, Va ] ] + Im [ f [ En, Va ] ] = 0
As it turned out, after the plot was formed, only the plot of the "Real" section was similar to the plot in my reading source. So, I think the condition changed to
Re [ f [ En, Va ] ] = 0.
n in my table means the energy level, because the En variable I meant from the start is actually the eigen / energy value. However, I also do not understand how to generate it from a Wolfram Mathematica encoding result. I had thought that maybe the results obtained from the Wolfram Mathematica coding were only in the form of a plot, while the table was created manually by entering the specified coordinate values. Maybe I need to tell you that I encountered this problem when I read an article / journal, then I tried to study it and found the incomprehension that I asked about. What if I tell / send the journal / article that I am studying so you can understand what I mean and my problem becomes clear? :(
|
|
I apologize if my explanation is not understandable, Sir. It's shorter like this: I have a transcendental complex equation:
T := (E^(I*q*b)/(16*A^2*B*
H) (((A + H)^2) ((A + B)^2*
E^(2*I (k (a - b) - p*a)) - (A - B)^2*
E^(-2*I (k (a - b) - p*a))) + ((A - H)^2) ((A - B)^2*
E^(-2*I (k (a - b) + p*a)) - (A + B)^2*
E^(2*I (k (a - b) + p*a))) +
2 (A^2 - B^2) (A^2 - H^2) (E^(2*I*p*a) - E^(-2*I*p*a))));
or in the form of a picture is as follows 
I consider the T function to be f[En_] because the value I want to find is the value of En . The known variables are:
c = 137.036;
Vb = 50000;
a = 0.01;
b = 0.02;
k = Sqrt[En^2 - c^4]/c;
p = Sqrt[(En + c^2 - Va) (En - c^2 - Va)]/c;
q = Sqrt[(En + c^2 - Vb) (En - c^2 - Vb)]/c;
A = Sqrt[(En - c^2)/(En + c^2)];
B = Sqrt[(En - c^2 - Vb)/(En + c^2 - Vb)];
H = Sqrt[(En - c^2 - Va)/(En + c^2 - Va)];
The transcendental complex equation is solved using Wolfram Mathematica and the solution is shown in the form of a plot and table that looks like the following. 
and 
What I want is to know the coding used to get the plot and table results as I show them. How?
|
|
Thanks for your explanation. But I still do not understand what you want to do. Given your function
f [ En, Va ]
do you want those En and Va where
Re [ f [ En, Va ] ] == 0
as Werner pointed out or Re [ f [ En, Va ] ] == Im [ f [ En, Va ] ]
|
|
Thank you very much also Mr. Werner Geiger.
I will try to understand the description that you give. This really adds to my knowledge, who is new to using Wolfram Mathematica. Well, as Hans asked in his reply to this question, about what if I tell you what my problem really is, I'll tell you. So, I have a transcendental complex equation and its variables which I mention as my initial coding. Then I coded it to bring up the plot and found the result I was looking for. The reference plot that I want to make is like the following image, 
However, the plot that I produce from my coding is still very much different from the shape of the image I want. Here's a plot of the results of my coding 
I have the assumption that the plot line that matches my reference plot is the blue plot line, that is, the plot of the "Real" section. Then I tried again to make a new plot by removing the coding leading to the "Imaginary" section so that the resulting plot was "Real" only. However, an error appears in the output. After I saw the coding given by Werner Geiger, it turned out that it was quite complicated to use the coding used to bring up the "Real" only, not as simple as my assumption which was only by deleting the codes that referred to the "Imaginary" section. Furthermore, in my reference plot, there are points along the lines which I will write in tabular form as follows. 
The values ​​in the table are En values. That's why I initially asked about how to find the value of En at the point where Va intersects with En , or the value of En on the blue line ("Real") on the plot. Related to simplifying a function manually, I have tried to simplify or convert it in trigonometric form so that it can be separated between the Real part and the Imaginary part. However, the form of the equation is still complicated, in my opinion. So that the equation that I use in my coding is still the original equation, not the one in trigonometric form. Like this is actually my problem. I'm having a hard time plotting the results for solving the equation and writing the values ​​down in a table.
|
|
Point 1: My mistake First of all remove the Evaluate within my definition of f. This is not correct. It does not change the function values but the contour-plot. The plots now look like (To get the same colors for real and imaginary parts in both plots I added explicit colors cols={RGBColor[0.4, 0.7, 1], RGBColor[1, 0.5, 0]} for ContourStyle and PlotStyle):
 Point 2: Strange table-values I don't understand why your table does not show values like mine. Maybe executing a
Clear["Global'*"]
might help. BTW: It is never a good idea to use symbols starting with uppercase letters. Your Va and En shoul better read va and en. Point 3: Global function definition For not repeating the definition of function f again and again, I define it as global now. (This could be simplified for avoiding the same calculations over and over again). You must execute this one times:
Clear[f];
f[Va_, En_] :=
Module[{Vb = 50000, a = 0.01, b = 0.02, c = 137.036, k, p, q, A, B,
H},
k = Sqrt[En^2 - c^4]/c;
p = Sqrt[(En + c^2 - Va)*(En - c^2 - Va)]/c;
q = Sqrt[(En + c^2 - Vb)*(En - c^2 - Vb)]/c;
A = Sqrt[(En - c^2)/(En + c^2)];
B = Sqrt[(En - c^2 - Vb)/(En + c^2 - Vb)];
H = Sqrt[(En - c^2 - Va)/(En + c^2 - Va)];
Simplify[
(E^(I*q*b)/(16*A^2*B*H)*
(((A + H)^2)*((A + B)^2*E^(2*I*(k*(a - b) - p*a)) - (A - B)^2*
E^(-2*I*(k*(a - b) - p*a))) + ((A - H)^2)*((A - B)^2*
E^(-2*I*(k*(a - b) + p*a)) - (A + B)^2*
E^(2*I*(k*(a - b) + p*a))) +
2*(A^2 - B^2)*(A^2 - H^2)*(E^(2*I*p*a) - E^(-2*I*p*a))))]
];
Our program now looks like:
If[True, Block[{En, Va, tab,
cols = {RGBColor[0.4, 0.7, 1], RGBColor[1, 0.5, 0]}},
(* Define function; f is defined globally *)
If[False, Print[f[Va, En]]];
(* Print a table with function-values *)
tab = Table[Column[Round[ReIm[f[Va, En]], 0.01], Center]
, {Va, 0, 50000, 5000}, {En, 30000, 70000, 4000}];
Print[Grid[Join[
{Prepend[Range[30000, 70000, 4000], "Va\\En:"]},
Join[Transpose[{Range[0, 50000, 5000]}], tab, 2]],
Dividers -> {{2 -> True}, {1 -> True, 2 -> True}}]];
(* Show real and imaginary part of function-values *)
Print[ContourPlot[{Re[f[Va, En]], Im[f[Va, En]]}, {Va, 0,
50000}, {En, 30000, 70000},
PlotRange -> All,
ContourStyle -> cols,
PlotPoints -> {50, 40}, MaxRecursion -> 2,
FrameLabel -> {"Va", "En"}, PlotLegends -> {"Re(f)", "Im(f)"}
]];
(* Show real and imaginary part of function-values in 3D *)
Print[Plot3D[{Re[f[Va, En]], Im[f[Va, En]]}, {Va, 0, 50000}, {En,
30000, 70000},
PlotRange -> {All, All, Automatic},
PlotStyle -> cols,
PlotPoints -> {50, 40}, MaxRecursion -> 2,
AxesLabel -> {"Va", "En"}, PlotLegends -> {"Re(f)", "Im(f)"}
]];
]];
Point 4: Your actual problem If I understand you correctly, you are looking for the solution of Re[ f[va0, En] ] == h0 for any given value of va0 and h0. First of all we redraw the contour- and 3D plots of the real part and add some more information on it including the desired va0 and h0 values. In addition we draw another plot with the sections Re[ f[va0, En] ] of our function for the desired va0 values.
If[True, Block[{En, Va, va0s, cntVa0s, h0s, cntH0s, prVa = {0, 50000},
prEn = {30000, 70000}, prEnL = 6000, col},
(* Desired Va values and function heights *)
va0s = Range[First[prVa], Last[prVa], 10000];
cntVa0s = Length[va0s];
h0s = {-1, -0.5, -0.25, -0.125, -0.075, 0, 0.075, 0.125, 0.25, 0.5,
1}; cntH0s = Length[h0s];
(* Show real part Re(f) of function values *)
Print[ContourPlot[Re[f[Va, En]]
, {Va, First[prVa], Last[prVa]}, {En, First[prEn], Last[prEn]},
PlotRange -> All,
Contours -> h0s, ContourLabels -> True,
ColorFunction -> "TemperatureMap",
PerformanceGoal -> "Quality",
FrameLabel -> (Style[#, Black, Larger] & /@ {"Va", "En"}),
PlotLegends -> Automatic,
PlotLabel -> Style["Re[ f[Va, En] ] contour", Black, Bold],
Epilog -> {Darker[Green], Thin,
Line[{{#, First[prEn]}, {#, Last[prEn]}} & /@ va0s]}
]];
(* Show real part Re(f) of function values in 3D *)
Print[Plot3D[Re[f[Va, En]]
, {Va, First[prVa], Last[prVa]}, {En, First[prEn], Last[prEn]},
PlotRange -> {All, All, Automatic},
ColorFunction -> "TemperatureMap",
PerformanceGoal -> "Quality",
AxesLabel -> (Style[#, Black, Larger] & /@ {"Va", "En", "Re(f)"}),
PlotLegends -> Automatic,
PlotLabel -> Style["Re[ f[Va, En] ]", Black, Bold]
]];
(* Show sections through Re(f) at the points va0 *)
col[va_] :=
Hue[2/3 + (0 - 2/3)/(Last[prVa] - First[prVa])*(va - First[prVa])];
Print[Plot[Evaluate[Table[Re[f[va0, En]], {va0, va0s}]]
, {En, First[prEn], Last[prEn]},
PlotRange -> {prEn - {prEnL, 0}, Automatic},
AxesOrigin -> {First[prEn], 0},
PerformanceGoal -> "Quality",
PlotStyle -> (col[#] & /@ va0s),
Frame -> True,
FrameLabel -> (Style[#, Black, Larger] & /@ {"En",
"Re[f[va0, En]]"}),
PlotLegends -> (Style[Row[{"va0 = ", #}], 10] & /@ va0s),
PlotLabels ->
Placed[va0s, {Scaled[#/10], Above} & /@ Range[cntVa0s]],
PlotLabel ->
Style["Sections Re[ f[va0, En] ], va0 \[Element] va0s", Black,
Bold],
ImageSize -> Scaled[0.85], AspectRatio -> 5/4,
Epilog -> {Darker[Green], Thin,
Line[{{First[prEn] - prEnL, #}, {Last[prEn], #}} & /@ h0s],
Inset[
Style[Row[{"h0 = ", #}], 10, ![enter image description here][2]
Background -> White], {First[prEn] - prEnL/2, #}, {0,
0}] & /@ h0s}
]];
]];


Then we solve the equations Re[ f[va0, En] ] == h0 for some given values va0 an h0. We define a new global function r[Va_ ,En_ ] for the simplified real part Re[ f[va0, En] ]. Solve is not able to solve that, hence we use NSolve. But this does not terminate within reasonable time (Interrupt wit Alt+.). So we try to find solutions with FindRoot, which takes an approximation per solution. We roughly lookup the approximations in the previous section-plot. They are given as an association
solApproxs = <| {va0,h0} -> {En01, En02, ...}, ... |>. For each {va0,h0}-pair there is a list with zero to n En-approximations. Note: I defined only some solution approximations, not all of them. In the same way, we collect the solutions within an association
sols = <| {va0,h0} -> {En1, En2, ...}, ... |> for later use. For each {va0,h0}-pair there is a list with zero to n En-solutions. Finally we draw our contour- and section plot again exactly like before, but with the solutions marked by points.
Clear[r];
r[Va_, En_] := Simplify[Re[f[Va, En]]];
If[True, Block[{test = False, En, Va, va0s, cntVa0s, h0s, cntH0s,
prVa = {0, 50000}, prEn = {30000, 70000}, prEnL = 6000,
solApproxs, approxs, sols, sol, col, va0},
(* Desired Va values and function heights *)
va0s = Range[First[prVa], Last[prVa], 10000];
cntVa0s = Length[va0s];
h0s = {-1, -0.5, -0.25, -0.125, -0.075, 0, 0.075, 0.125, 0.25, 0.5,
1}; cntH0s = Length[h0s];
(* From the plots take some approximations of the solutions for \
{va0,h0} *)
solApproxs = <|{50000, 1} -> {36000, 44000, 59000, 65000}, {50000,
0.5} -> {37000, 43000, 59000, 65000}, {50000, 0} -> {38000,
41000, 61000, 63000},
{20000, 0} -> {34000, 37000, 46000, 53000, 62000, 65000},
{10000, 1} -> {68000}, {10000, 0.5} -> {33000, 36000,
67000}, {10000, 0} -> {33000, 40000, 49000, 59000, 66000}|>;
(* Solve the equations Re[f[va0,En]] \[Equal]
h0 for given values va0 and h0. *)
(* Collect the solutions within sols *)
sols =
Association[
Flatten[Table[{va0, h0} -> {}, {va0, va0s}, {h0, h0s}]]];
Do[(* va0 *)
If[test && ! MemberQ[{50000, 20000, 10000}, va0], Continue[]];
Do[(* h0 *)
If[test && ! MemberQ[{1, 0.5, 0(*,-0.075*)}, h0], Continue[]];
Print[
Style[Row[{"Solving for va0 = ", va0, ", h0 = ", h0}], Blue,
Bold]];
(* sol=Solve[r[va0,En]\[Equal]h0,En]; does not work *)
(*sol=NSolve[r[va0,En]\[Equal]h0&&En\[Element]Reals&&First[
prEn]\[LessEqual]En\[LessEqual]Last[prEn],En,Complexes];
does not terminate *)
approxs = solApproxs[{va0, h0}];
If[MissingQ[approxs],
Print["No approximation known!"]
,
Do[(* approx *)
sol = FindRoot[r[va0, En] == h0, {En, approx}];
If[test, Echo[{approx, sol}, "{approx,sol}: "]];
AppendTo[sols[{va0, h0}], En /. First[sol]]
, {approx, approxs}];
];
(* just for beauty *)
sols[{va0, h0}] = Sort[DeleteDuplicates[sols[{va0, h0}]]];
Print[Row[{"Solutions En = ", sols[{va0, h0}]}]]
, {h0, h0s}]
, {va0, va0s}];
If[test && False,
Print["All solutions En =\n", Column[Normal[sols]]]];
(* Show real part Re(f) of function values with solutions marked *)
Print[ContourPlot[r[Va, En]
, {Va, First[prVa], Last[prVa]}, {En, First[prEn], Last[prEn]},
PlotRange -> All,
Contours -> h0s, ContourLabels -> True,
ColorFunction -> "TemperatureMap",
PerformanceGoal -> "Quality",
FrameLabel -> (Style[#, Black, Larger] & /@ {"Va", "En"}),
PlotLegends -> Automatic,
PlotLabel -> Style["Re[ f[Va, En] ] contour", Black, Bold],
Epilog -> {Darker[Green], Thin,
Line[{{#, First[prEn]}, {#, Last[prEn]}} & /@ va0s],
PointSize[Large],
Point[Flatten[
Table[If[
sols[{va0, h0}] != {}, {va0, #} & /@ sols[{va0, h0}],
Nothing], {va0, va0s}, {h0, h0s}], 2]]}
]];
(* Show sections through Re(f) at the points va0 with solutions \
marked *)
col[va_] :=
Hue[2/3 + (0 - 2/3)/(Last[prVa] - First[prVa])*(va - First[prVa])];
Print[Plot[Evaluate[Table[r[va0, En], {va0, va0s}]]
, {En, First[prEn], Last[prEn]},
PlotRange -> {prEn - {prEnL, 0}, Automatic},
AxesOrigin -> {First[prEn], 0},
PerformanceGoal -> "Quality",
PlotStyle -> (col[#] & /@ va0s),
Frame -> True,
FrameLabel -> (Style[#, Black, Larger] & /@ {"En",
"Re[f[va0, En]]"}),
PlotLegends -> (Style[Row[{"va0 = ", #}], 10] & /@ va0s),
PlotLabels ->
Placed[va0s, {Scaled[#/10], Above} & /@ Range[cntVa0s]],
PlotLabel ->
Style["Sections Re[ f[va0, En] ], va0 \[Element] va0s", Black,
Bold],
ImageSize -> Scaled[0.85], AspectRatio -> 5/4,
Epilog -> {Darker[Green], Thin,
Line[{{First[prEn] - prEnL, #}, {Last[prEn], #}} & /@ h0s],
Inset[
Style[Row[{"h0 = ", #}], 10,
Background -> White], {First[prEn] - prEnL/2, #}, {0,
0}] & /@ h0s,
PointSize[Large],
{va0 = #; col[va0],
Point[Flatten[
Table[If[
sols[{va0, h0}] != {}, {#, h0} & /@ sols[{va0, h0}],
Nothing], {h0, h0s}], 1]]} & /@ va0s }
]];
]];


I think, your problem is solved by this approach. At least numerically. I don't know if there is a closed analytical solution. Probably one would have to simplify the function significantly manually. With Simplify it is still too complicated.
|
|
BTW: The method with GetCoordinates mentioned above by Hans is perfect for picking the approximations from the section-plot:
- Right click into the section plot and select GetCoordinates
- For all cross sections of a curve with va0 with a horizontal line h0:
- Click on the cross section point
- Ctrl+C
- Create a new empty input cell
- Ctrl+V
- Add "{va0, h0}->" in front of the list
- Enclose the right hand side list rhs into Round[ Flatten[ rhs[[All,1]] ], 10] (or Round[...,1])
- Execute the cell. The output is exactly what you need as an element of solApproxs.
You can copy it as Plain Text and paste it into the definition of solApproxs.
|
|
As Werner pointed out your f[En_] is somewhat strange. Type for example (after your code has run) f[50000]. What do you get? What about telling us what exactly your problem is. Perhaps there is an alternative way to find a solution?
|
|
Your function f[En_ ] is defined strangely. All those subexpressions k, p, q, A, B, H go into the function body and Va and En remain as variables/parameters. Hence f should be defined as f[] or better f[Va_ , En_ ]. If you want to get the value of f at some point {Va0, En0} just evaluate f[Va0, En0]. I have recoded your code and changed a little:
For the function definition:
- Added Symbol c just for readability.
- Changed the Arguments of f to f[Va_ ,En_ ].
- Added Evaluate[Simplify[...]] to the function body for better performance.
For function values:
- Added a Table with some values of f. Real and imaginary parts as a
column.
For the contour plot:
- Increased PlotPoints
- Added MaxRecursion
- Omitted Epilog
- Changed PlotLegends
- Omitted AxesOrigin
- Added FrameLabel
This gives:
If[True, Block[{En, Va, Vb, c, k, p, q, A, B, H, a, b, f, tab, t},
(* Define function *)
c = 137.036;
Vb = 50000;
k = Sqrt[En^2 - c^4]/c;
p = Sqrt[(En + c^2 - Va) (En - c^2 - Va)]/c;
q = Sqrt[(En + c^2 - Vb) (En - c^2 - Vb)]/c;
A = Sqrt[(En - c^2)/(En + c^2)];
B = Sqrt[(En - c^2 - Vb)/(En + c^2 - Vb)];
H = Sqrt[(En - c^2 - Va)/(En + c^2 - Va)]; a = 0.01; b = 0.02;
f[Va_, En_] := Evaluate[Simplify[
(E^(I*q*b)/(16*A^2*B*H)*
(((A + H)^2)*((A + B)^2*E^(2*I*(k*(a - b) - p*a)) - (A - B)^2*
E^(-2*I*(k*(a - b) - p*a))) + ((A - H)^2)*((A - B)^2*
E^(-2*I*(k*(a - b) + p*a)) - (A + B)^2*
E^(2*I*(k*(a - b) + p*a))) +
2*(A^2 - B^2)*(A^2 - H^2)*(E^(2*I*p*a) - E^(-2*I*p*a))))]];
If[False, Print[f[Va, En]]];
(* Print a table with function-values *)
tab = Table[Column[Round[ReIm[f[Va, En]], 0.01], Center]
, {Va, 0, 50000, 5000}, {En, 30000, 70000, 4000}];
Print[Grid[Join[
{Prepend[Range[30000, 70000, 4000], "Va\\En:"]},
Join[Transpose[{Range[0, 50000, 5000]}], tab, 2]],
Dividers -> {{2 -> True}, {2, True}}]];
(* Show real and imaginary part of function-values *)
Print[ContourPlot[{Re[f[Va, En]], Im[f[Va, En]]}, {Va, 0,
50000}, {En, 30000, 70000},
PlotRange -> All,
PlotPoints -> {50, 40}, MaxRecursion -> 2,
FrameLabel -> {"Va", "En"}, PlotLegends -> {"Re(f)", Im["f"]},
Epilog -> {(*Black,PointSize[0.025],Point[{Va,En}]*)}]];
]];

|
|
By the way: The function becomes more vivid if you plot it in 3D:
(* Show real and imaginary part of function-values in 3D *)
Print[Plot3D[{Re[f[Va, En]], Im[f[Va, En]]}, {Va, 0, 50000}, {En,
30000, 70000},
PlotRange -> {All, All, Automatic},
PlotPoints -> {50, 40}, MaxRecursion -> 2,
AxesLabel -> {"Va", "En"}, PlotLegends -> {"Re(f)", Im["f"]}]];

|
|
Extraordinary. Thank you for the reply and explanation, Sir. This really helps increase my knowledge. The function f [En_] is indeed oddly defined and very complicated, in my opinion. At first, I tried to separate the calculations by defining Va as only one value, which is only 0 , only 10000 , up to 50000 only, in order to find the values ​​of En when Va=0 , when Va=10000 , until when Va = 50000 . However, the graph also ends up fragmentary, even though I want the graph that appears to be a graph of the relationship between Va and En , where Va has a value range of 0 to 50000 . Finally, I have the idea to combine it by writing Va as in my coding above and it appears graph of the relationship between Va and En . I've tried running the coding you provide, but I don't understand why the result in my notebook looks like this. 
Actually here my problem is to find the value of En when the value of Va has been determined, which is 0 to 50000 . As I stated in the previous question, I want to find the value of En at the point of intersection between Va (horizontal axis) and En (vertical axis) ). I mean this, when I select a point on the horizontal axis (Va ), for example 30000 , then I drag the line up until it meets the blue "Real" line, and I stop at that point (let's call it the second point), what is the En value at the second point? then I draw the line up again until it meets the blue line "Real" again and I stop there (let's call it the third point), what is the value of En in the third point? Like that I mean. Is my question explanation and meaning too difficult to understand? And, how do you write it in coding? Should Va be defined at the beginning of coding?
|
|
No, you did not define them. There they are variables to be used by ContourPlot, and as far as I know they are local to the plot-routine. So in your Point statement both have no value. Look at your error message, there appears En , without a value of course. Try your ContourPlot without Point[{Va, En}] and there will be no error.
|
|
Oh. Yes. You are right, Sir.
I've tried it and the error notification doesn't appear anymore.
Thank you very much. And then, from the resulting graph, when I point to a point on the line "Real" or "Imaginary" in the graph, a long equation will appear where Va and En are still variables, not values. What should I do if I want to find the value at the point of intersection between Va (horizontal axis) and En (vertical axis)?
|
|
Go with the pointer unto your plot, then do a right mouse-click, a window opens. click Get Cooridinates and you can chose any region of the plot with your mouse.
|
|
Can the coordinate values be written together in a table, Sir?
|
|
Do as said above (GetCoordinates), move to the point of interest, then left mouse-click, then Ctrl-C, then same procedure at the next point and so on. Finally move to an empty cell and use Ctrl-V. A list of the points chosen will appear. You can of course give it a name:
type for example pts = Ctrl-V
|
|
Yes, I understand what you mean and have tried it. Thank you, Sir.
|
|
What do you mean by
Point[{Va, En}]
Here Va and En are not defined!
|
|
Va is in the range 0 to 50000. En is the value I want to find and is in the range 30000 to 70000. I define Va and En in the form {Va, 0, 50000}, {En, 30000, 70000}, located in line with the code "ContourPlot {bla bla bla"
|
|
Reply to this discussion
in reply to
|