# Plotting equation of error function

I want plot $W$ vs $t$

eqn= t^3 + (4 - 8/Sqrt[\[Pi]]) w^2 + (3 w^4)/8 + (2 E^(w^2/t) \[Pi] w^2 (-2 t + w^2) Erfc[w/(Sqrt Sqrt[t])]^2)/t ==1/8 t (96 + 56 t + 11 w^2) + (E^(w^2/(2 t)) w (-64 w^2 + Sqrt[\[Pi]] (t (-160 + 7 t) - 8 (-8 + t) w^2 + 3 w^4)) Erfc[w/(
Sqrt Sqrt[t])])/(8 Sqrt Sqrt[t])


I tried Plot using: solns= Solve[eqn, w] // Normal and obtain all solutions of $W$ as the function of $t$ and then plot with

Plot[Evaluate[w /. solns], {t, 0, 3},PlotRange -> {{0.001, 3}, {-3, 3}}, Frame -> True, AspectRatio -> 1, PlotLegends -> Automatic]


But I not getting. I try using CountorPlot, but the plot is horrible. Thanks in advance!.

## 2 Answers

Because it doesn't seem to be possible to solve for $w(t)$, what you could do to obtain the plot of $w(t)$ is by numerically solving for $w$ for different values of $t$ with FindRoot. The results can then be plotted with ListLinePlot.

numberOfPoints = 300;
wStart = 1;
ts = Rest @ Subdivide[0, 3, numberOfPoints];
ws = Last @* Last /@ Table[
FindRoot[Evaluate[eqn /. t -> n], {w, wStart}],
{n, ts}
];
ListLinePlot[Transpose @ {ws, ts}]


(Note that Rest is to exclude the case in which $t = 0$.) # Update

At first I ignored the FindRoot::lstol messages, which I shouldn't have. One way of checking if each pair of numerically-obtained $(w, t)$ actually satisfies eqn is by looking at the difference between its left and right sides. The difference should be close to zero.

Trying this:

numberOfPoints = 5;
wStart = 1;
ts = Rest @ Subdivide[0, 3, numberOfPoints];
ws = Last @* Last /@ Table[
FindRoot[Evaluate[eqn /. t -> n], {w, wStart}],
{n, ts}
];
points = Transpose @ {ws, ts};
diff = Subtract @@ List @@ eqn;
diff /. {w -> First @ #, t -> Last @ #} & /@ points


we get:

{-4.72339, -14.1116, -26.7086, -41.0978, -55.888}


As they're not relatively close to zero, the numerical solutions are bad. One way of addressing this is by giving FindRoot a better wStart.

To find it, we could explore the plot of the difference at some values of t to visually identify w at which diff is zero. It appears that

Plot[Evaluate[Table[diff /. t -> n, {n, ts}]], {w, -3, 10}, PlotRange -> {-600, 50}] which signifies that wStart should be somewhere near -2 for $t \in (0, 3]$. Let's try wStart = -3:

numberOfPoints = 5;
wStart = -3;
ts = Rest @ Subdivide[0, 3, numberOfPoints];
ws = Last @* Last /@ Table[
FindRoot[Evaluate[eqn /. t -> n], {w, wStart}],
{n, ts}
];
points = Transpose @ {ws, ts};
diff = Subtract @@ List @@ eqn;
diff /. {w -> First @ #, t -> Last @ #} & /@ points


from which we get

{2.226*10^-13, 4.9738*10^-14, 4.36984*10^-13, 7.31859*10^-13, -4.54747*10^-13}


which are all close to zero, so this wStart is good. Now, back to the code at the beginning, with the better wStart (and note that because t shouldn't be too close to zero, I let ts start at 11/100 rather than 0):

numberOfPoints = 300;
wStart = -3;
ts = Subdivide[11/100, 3, numberOfPoints];
ws = Last @* Last /@ Table[
FindRoot[Evaluate[eqn /. t -> n], {w, wStart}],
{n, ts}
];
ListLinePlot[Transpose @ {ws, ts}]


No more FindRoot::lstol messages. • Hi @Talki, thanks. I have a problem with your code because I have an alert in the plot, of the kind: ************************ $FindRoot:$ The line search decreased the step size to within tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the merit function. You may need more than MachinePrecision digits of working precision to meet these tolerances. ******************** $General:$ Further output of FindRoot::lstol will be suppressed during this calculation. ************************ And the plot blue is the same, but without the frame. – will.al Aug 16 '18 at 2:05
• @will.al Those warnings come from FindRoot for some values of t and wStart, and basically mean that w solved may not be correct. You might want to adjust wStart or perhaps change the method of FindRoot until the warnings disappear, but I wouldn’t find them concerning, because the plot is smooth. As to the frame, it’s just the matter of formatting the plot; consult the documentation on relevant options of ListLinePlot. – Taiki Aug 16 '18 at 6:34
• @will.al Gosh, I look into the issue and the numerical solutions are really bad... Updating the answer right now... – Taiki Aug 16 '18 at 7:26
• @will.al Done! What we can learn from this is that it is important to find a good starting point for FindRoot somehow first. – Taiki Aug 16 '18 at 8:54
• Thank you so much @Taiki. – will.al Aug 16 '18 at 20:58

A way:

eqn = t^3 + (4 - 8/Sqrt[\[Pi]]) w^2 + (3 w^4)/
8 + (2 E^(w^2/t) \[Pi] w^2 (-2 t + w^2) Erfc[
w/(Sqrt Sqrt[t])]^2)/
t - (1/8 t (96 + 56 t +
11 w^2) + (E^(w^2/(2 t)) w (-64 w^2 +
Sqrt[\[Pi]] (t (-160 + 7 t) - 8 (-8 + t) w^2 + 3 w^4)) Erfc[
w/(Sqrt Sqrt[t])])/(8 Sqrt Sqrt[t])) // Simplify

ContourPlot[eqn == 0, {t, 1/10, 3}, {w, -3, 3}, FrameLabel -> Automatic] In near point t=0

ContourPlot[eqn == 0, {t, 1/10000, 3}, {w, -3, 3}, FrameLabel -> Automatic,
PlotPoints -> 100, MaxRecursion -> 4, WorkingPrecision -> 20]


Real part of eqn:

 Show[{ContourPlot[(eqn // Re) == 0, {t, -2, -1/100}, {w, -3, 3},
FrameLabel -> Automatic, WorkingPrecision -> 20],
ContourPlot[(eqn // Re) == 0, {t, 1/100, 3}, {w, -3, 3},
FrameLabel -> Automatic, WorkingPrecision -> 20]},
PlotRange -> {{-3, 3}, {-3, 3}}] • Thank you so much @Mariusk Iwaniuk. – will.al Aug 16 '18 at 20:58