5
$\begingroup$

I tried to plot and find the coordinates of the intersectrions of more than two curves in a the plot. Is there a special way to do this?

Here's my code so yu can visualize the whole thing.

m = 9.1*10^-31;
L = .5 ; 
ℏ = 1.055*10^-34;
e = ℏ^2/(2 m) (π/L)^2 (1/(1.602*10^-19));
V1 = 2 e;
V2 = 5 e;
V3 = 8 e;
ν1 = V1/e;
ν2 = V2/e;
ν3 = V3/e;
Plot[
  {Sqrt[ν1 - ϵ], Sqrt[ν2 - ϵ], Sqrt[ν3 - ϵ], Sqrt[ϵ] Tan[π/2 Sqrt[ϵ]], 
   -Sqrt[ϵ] Cot[π/2 Sqrt[ϵ]]}, 
 {ϵ, 0, 10}]

plot

$\endgroup$
  • $\begingroup$ You might be interested in the built-in physical constants, e.g., Entity["PhysicalConstant", "ElectronMass"]["Value"]//QuantityMagnitude, Entity["PhysicalConstant", "ReducedPlanckConstant"]["Value"]//QuantityMagnitude, Entity["PhysicalConstant", "ElementaryCharge"]["Value"]//QuantityMagnitude $\endgroup$ – Bob Hanlon May 24 at 18:42
8
$\begingroup$
plot = Plot[{Sqrt[ν1 - ϵ], Sqrt[ν2 - ϵ], Sqrt[ν3 - ϵ], 
    Sqrt[ϵ] Tan[π/2 Sqrt[ϵ]], -Sqrt[ϵ] Cot[π/2 Sqrt[ϵ]]}, {ϵ, 0, 10}];

Graphics`Mesh`MeshInit[]

intersections = Graphics`Mesh`FindIntersections[plot];
Show[plot, Epilog -> {Red, PointSize[Large], Point@intersections}]

enter image description here

See also: Marking points of intersection between two curves

$\endgroup$
  • $\begingroup$ this is great, thanks, but how do i know the coordinates of the points? $\endgroup$ – Sosa May 24 at 16:58
  • 1
    $\begingroup$ @Sosa, intersections is list of coordinates where two lines intersect. $\endgroup$ – kglr May 24 at 17:06
3
$\begingroup$

You can also do this non-graphically:

m = 9.1*10^-31;
L = .5;
hb = 1.055*10^-34;
e = hb^2/(2 m) (\[Pi]/L)^2 (1/(1.602*10^-19));
V1 = 2 e;
V2 = 5 e;
V3 = 8 e;
v1 = V1/e;
v2 = V2/e;
v3 = V3/e;
f1[x_] = Sqrt[v1 - x];
f2[x_] = Sqrt[v2 - x];
f3[x_] = Sqrt[v3 - x];
f4[x_] = Sqrt[x] Tan[\[Pi]/2 Sqrt[x]];
f5[x_] = -Sqrt[x] Cot[\[Pi]/2 Sqrt[x]];
functions = Plot[Evaluate@Through[{f1, f2, f3, f4, f5}[x]], {x, 0, 10}]

enter image description here

results = Quiet[Partition[
  Flatten[Thread[{#2, #1[#2]}] & @@@ Cases[{#1, 
     ToRules@(Reduce[{#1[x] == #2[x], 0 <= x <= 10}, x])} & @@@ 
       Subsets[{f1, f2, f3, f4, f5}, {2}], {a_, b__} -> {a, 
         ReplaceAll[x, {b}]}]], 2]]

(* {{0.463001, 1.23976}, {1.6379, 0.601749}, {0.600243, 
  2.09756}, {4.67897, 0.566599}, {2.31953, 1.63722}, {0.662803, 
  2.70873}, {5.60865, 1.5464}, {2.60346, 2.32305}}  *)

Show[functions, ListPlot[results, PlotStyle -> Black]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.