# How to plot even function without noticeable asymmetry

I am trying to plot a series of functions. But the picture is looking a bit asymmetric despite that the functions are even. If I try to use Geometricaltransformation function to reflect the plot that plot legend is getting reflected too and this is not required. What can I do? I integrate, summ and put the option that function is even in the code.

texStyle = {FontFamily -> "Latin Modern Roman", FontSize -> 20};
p0 = 1;(* pn1=5;p1=15;p2=40;p3=1000;*) g0 = 0.1; g1 = 1.5; g2 = 3.0; \
g3 = 5.0; eF = 500; B0 = 15; n0 =
Ceiling[eF/B0]; ni = 5; kFd = 3; T = 2;
g[B_, ga_] := ga*(1 + (2*B/ga/Sqrt[\[Pi]])^4)^(1/8);
igl[ga_, e_, n_, B_] :=
g[B, ga]/((e - B*(n - 1/2))^2 + (g[B, ga])^2);
igg[ga_, e_, n_, B_] :=
Sqrt[2*\[Pi]]*Exp[-2*(e - B*(n - 1/2))^2 /(g[B, ga])^2]/g[B, ga];
igd[ga_, e_, n_, B_] :=
If[g[B, ga] > Abs[e - B*(n - 1/2)], (2/\[Pi])*
Sqrt[(g[B, ga])^2 - (e - B*(n - 1/2))^2 ]/(g[B, ga])^2, 0];
n1[e_, \[Theta]_] := Ceiling[1.0*e/B0/Cos[\[Theta]]];
p1[\[Theta]_, g_] :=
Ceiling[10*
g*(1 + (2*B0*Cos[\[Theta]]/g/Sqrt[\[Pi]])^4)^(1/8)/B0/
Cos[\[Theta]]];
n0t = Ceiling[eF/B0 + 1/2];
f0g[e_, \[Theta]_, g_] :=
g*B0*Cos[\[Theta]]*
Sum[(BesselJ[p, kFd*Tan[\[Theta]]])^2*
igg[g, e, n, B0*Cos[\[Theta]]]*
igg[g, e, n + p, B0*Cos[\[Theta]]], {n,
n1[e, \[Theta]] - p1[\[Theta], g],
n1[e, \[Theta]] + p1[\[Theta], g]}, {p, -p1[\[Theta], g],
p1[\[Theta], g]}];
f1g[\[Theta]_, g_] :=
Sum[f0g[eF + 2*(i + 1/2)*T/ni, \[Theta],
g]/(Cosh[((i + 1/2)/ni)])^2, {i, -3*ni, 3*ni - 1}]/ni/24/T;
f0l[e_, \[Theta]_, g_] :=
g*B0*Cos[\[Theta]]*
Sum[(BesselJ[p, kFd*Tan[\[Theta]]])^2*
igl[g, e, n, B0*Cos[\[Theta]]]*
igl[g, e, n + p, B0*Cos[\[Theta]]], {n,
n1[e, \[Theta]] - p1[\[Theta], g],
n1[e, \[Theta]] + p1[\[Theta], g]}, {p, -p1[\[Theta], g],
p1[\[Theta], g]}];
f1l[\[Theta]_, g_] :=
Sum[f0l[eF + 2*(i + 1/2)*T/ni, \[Theta],
g]/(Cosh[((i + 1/2)/ni)])^2, {i, -3*ni, 3*ni - 1}]/ni/24/T;
f0d[e_, \[Theta]_, g_] :=
g*B0*Cos[\[Theta]]*
Sum[(BesselJ[p, kFd*Tan[\[Theta]]])^2*
igd[g, e, n, B0*Cos[\[Theta]]]*
igd[g, e, n + p, B0*Cos[\[Theta]]], {n,
n1[e, \[Theta]] - p1[\[Theta], g],
n1[e, \[Theta]] + p1[\[Theta], g]}, {p, -p1[\[Theta], g],
p1[\[Theta], g]}];
f1d[\[Theta]_, g_] :=
Sum[f0d[eF + 2*(i + 1/2)*T/ni, \[Theta],
g]/(Cosh[((i + 1/2)/ni)])^2, {i, -3*ni, 3*ni - 1}]/ni/24/T;
f1g0 = 1.0*f1g[0, g0];
f1l0 = 1.0*f1l[0, g0];
f1d0 = 1.0*f1d[0, g0];
f1gEv[x_, y_] := If[x >= 0, f1g[x, y], f1g[-x, y]];
f1lEv[x_, y_] := If[x >= 0, f1l[x, y], f1l[-x, y]];
f1dEv[x_, y_] := If[x >= 0, f1d[x, y], f1d[-x, y]];

pg = Plot[{f1lEv[\[Theta]*\[Pi]/180.0, g0]/f1l0,
f1gEv[\[Theta]*\[Pi]/180.0, g0]/f1g0,
f1dEv[\[Theta]*\[Pi]/180.0, g0]/f1d0}, {\[Theta], -85, 85},
Frame -> True, BaseStyle -> {FontSize -> 16},
PlotLegends ->
Placed[LineLegend[
MaTeX[#,
Magnification -> 20/12] & @{"\\mathrm{Lorentzian\\ shape}",
"\\mathrm{Gaussian\\ shape}",
"\\mathrm{Self-consistent\\ Born\\ approximation}"},
LegendLayout -> {"Row", 1}, LegendFunction -> Framed], {Center,
Top}], FrameLabel -> {MaTeX["\\theta,\\ ^\\circ",
Magnification -> 22/12],
MaTeX["\\sigma_{zz}/\\sigma^0_{zz}", Magnification -> 22/12]},
PlotStyle -> {{Green}, {Thickness[0.006], Red,
Dashing[Large]}, {Thickness[0.004], Black,
Dashing[{0.0005, 0.01, 0.02, 0.02}]}},
PerformanceGoal -> {"Speed"}, PlotPoints -> 600,
MaxRecursion -> 0, PlotRange -> {Full, {0, 1.6}},
TicksStyle -> Directive[FontSize -> 16], ImageSize -> 1000];
Show[pg]

• Odd number of PlotPoints? – Henrik Schumacher Apr 26 at 11:20
• It made the plot more symmetric but not completely. – user2272592 Apr 26 at 11:50
• Hm. I see. I think there are two things going on: First, the dashing may cause slight assymetries. Second, there is quite some machine precision underflow happening due to Cosh and stuff. So, this is also a precision issue. Unfortunately, Plot will feed the function with machine precision numbers. You may try to precompute the function values in higher precision and then plot them with ListLinePlot instead, so that the rounding to machine precision takes place only in the end. Notice that you should to coerce all constants to exact number for this. – Henrik Schumacher Apr 26 at 12:02

A symmetric ParametricPlot does the trick:

ParametricPlot[{{θ, f1lEv[θ*π/180.0, g0]/f1l0},
{θ, f1gEv[θ*π/180.0, g0]/f1g0},
{θ, f1dEv[θ*π/180.0, g0]/f1d0},
{-θ, f1lEv[θ*π/180.0, g0]/f1l0},
{-θ, f1gEv[θ*π/180.0, g0]/f1g0},
{-θ, f1dEv[θ*π/180.0, g0]/f1d0}},
{θ, 0, 85},
Frame -> True,
BaseStyle -> {FontSize -> 16},
PlotStyle -> {{Green},
{Thickness[0.006], Red, Dashing[Large]},
{Thickness[0.004], Black, Dashing[{0.0005, 0.01, 0.02, 0.02}]}},
PerformanceGoal -> {"Speed"},
PlotPoints -> 600,
MaxRecursion -> 0,
PlotRange -> {Full, {0, 1.6}},
TicksStyle -> Directive[FontSize -> 16],
ImageSize -> 1000,
AspectRatio -> 1/GoldenRatio]


This requires setting the AspectRatio of the plot.

Remember that the list of PlotStyles is used cyclically, so we only need to write down every style once.

• I used the command to reflect the plot over axis but the plot legends is also reflected. If there is a way to reflect the plot without doubling of plot legends, please, tell me. Thanks. Show[pg, pg /. L_Line :> {Red, GeometricTransformation[L, ReflectionTransform[{-1, 0}]]}, PlotRange -> All] – user2272592 Apr 27 at 18:58
• If you use my code and add your PlotLegends etc. it should work, no? – Roman Apr 27 at 19:31
• You code seems to be fine. Thanks. I am asking about ReflectionTransfrom and PlotLegends. – user2272592 Apr 27 at 20:15
• I think GeometricTransformation  and ReflectionTransform is not the right path here. – Roman Apr 27 at 21:36