Search code examples
wolfram-mathematica

Plot two equations in one plot in Mathematica


I want to plot two equations in one plot using Mathematica. However, I don't have any idea about how to go about it. I need to add this equation (k^2 + Log[0.75]) to the plot. Then show the point where the curves meet each other. Please help! Here is my code:

eqn[d_Integer?NonNegative, r_, B_, nmax_Integer?Positive] := 
Sum[Exp[-n*\[Lambda]]*(1 - r)^
 n Exp[
  n*k^2 - k^2*B (HarmonicNumber[n + d] - HarmonicNumber[d])], {n, 
 1, nmax}] == -1 + Exp[\[Lambda]]/r;
BValues = {0, 0.5, 5};

Block[{$MaxExtraPrecision = 500}, 
ContourPlot[
Evaluate@Table[eqn[10, 0.25, B, 100], {B, BValues}], {k, 1/20, 
 2}, {\[Lambda], -1, 3.5}, 
 FrameLabel -> (Style[#, 14] & /@ {k, Subscript[\[Lambda], r]}), 
  RotateLabel -> False, PlotPoints -> 100, MaxRecursion -> 4, 
    AspectRatio -> 1/GoldenRatio, 
     PlotLegends -> 
      Placed[LineLegend[N@BValues, LegendLabel -> "B ="], {.1, .6}], 
   GridLines -> {None, {0}}, 
   GridLinesStyle -> Directive[Gray, AbsoluteThickness[1], Dashed]]]

Solution

  • Further to Bill's answer

    plot = Block[{$MaxExtraPrecision = 500},
       ContourPlot[Evaluate@Table[eqn[10, 0.25, B, 100], {B, BValues}],
        {k, 1/20, 2}, {λ, -1, 3.5}]];
    
    lines = Cases[Normal[First[plot]], Line[line_] :> line, Infinity];
    
    f1[x_] := Evaluate[Fit[lines[[1]], {x, x^2, x^3}, x]]
    f2[x_] := Evaluate[Fit[lines[[2]], {x, x^2, x^3}, x]]
    f3[x_] := Evaluate[Fit[lines[[3]], {x, x^2, x^3, x^4}, x]]
    
    xvals = k /. Quiet[
        FindRoot[#[k] == k^2 + Log[0.75], {k, 1.5}] & /@ {f1, f2, f3}];
    
    yvals = {f1[#1], f2[#2], f3[#3]} & @@ xvals;
    
    
    Show[plot, Plot[k^2 + Log[0.75], {k, 0, 2}], 
     Epilog -> {PointSize[Large], Point[Transpose[{xvals, yvals}]]}]
    

    enter image description here