# How to plot solutions of a system of equations by changing colours when one of the variables increases by step?

I have a system of two 3-variable equations $$SysEqs=\{f(x,y,z)=0\;,\;g(x,y,z)=0\}$$ where the domain of variables are $$6 < x < 2 \pi \\ - \frac{15}{100} < y < 0\\ 0 < z < \frac 32$$

I want by changing the variable $$z$$ by step $$0.01$$, i.e. for all the values $$z=\{0,\;0.01,...,1.49,\;1.50\}$$, find the points $$(x,y)$$ which solve this system of equation. Then illustrate these points in a 2D plot of $$x,y$$ and join these points to get a continuous line. Moreover, I need to see the behaviour of $$z$$ in this 2D plot by changing the colours if possible, I mean to show that by changing $$z$$ from $$0$$ to $$\frac 32$$, the curve's colour changes from Yellow to Black for example.

f[x_, y_, z_] :=
9 E^(373 y/50) - 3 E^(4 y) Cos[(173 x)/50] + E^(173 y/50) Cos[4 x] -
2 E^(2 y) Cos[(273 x)/50] - 3 Cos[(373 x)/50] +
8 E^(2 y) Cos[(273 x)/50] Cos[z] -
2 E^(273 y/50) Cos[2 x] (1 + 4 Cos[z]) ;

g[x_, y_, z_] := -2 E^(273 y/50) (1 + 4 Cos[z]) Sin[2 x] -
3 E^(4 y) Sin[(173 x)/50] + E^(173 y/50) Sin[4 x] -
2 E^(2 y) Sin[(273 x)/50] + 8 E^(2 y) Cos[z] Sin[(273 x)/50] -
3 Sin[(373 x)/50] ;

SysEqs:={  f[x,y,z]==0 , g[x,y,z]==0  }

6 < x < 2 \[Pi]
-0.15 < y < 0
0 < z < 3/2



Unfortunately, I am not familiar with programming in Mathematica, I am only able to do some simple calculations like using FindRoot to find the position of $$(x,y)$$, but I do not know what to do after that. I appreciate any comments and answers.

Using a graphical solution

Clear["Global*"]

f[x_, y_, z_] :=
9 E^(373 y/50) - 3 E^(4 y) Cos[(173 x)/50] + E^(173 y/50) Cos[4 x] -
2 E^(2 y) Cos[(273 x)/50] - 3 Cos[(373 x)/50] +
8 E^(2 y) Cos[(273 x)/50] Cos[z] - 2 E^(273 y/50) Cos[2 x] (1 + 4 Cos[z]);

g[x_, y_, z_] := -2 E^(273 y/50) (1 + 4 Cos[z]) Sin[2 x] -
3 E^(4 y) Sin[(173 x)/50] + E^(173 y/50) Sin[4 x] -
2 E^(2 y) Sin[(273 x)/50] + 8 E^(2 y) Cos[z] Sin[(273 x)/50] -
3 Sin[(373 x)/50];


The solution is the intersection of the contour plots for the equations.

EDIT: Range of x changed to {x, 5.6, 2Pi}

reaped = Reap[
cp3d = Legended[
ContourPlot3D[{f[x, y, z] == 0, g[x, y, z] == 0},
{x, 5.6, 2 Pi}, {y, -3/20, 0}, {z, 0, 3/2},
WorkingPrecision -> 15,
AxesLabel -> (Style[#, 14, Bold] & /@ {x, y, z}),
ContourStyle -> Opacity[0.75],
MeshFunctions ->
{Function[{x, y, z},
Sow[{x, y, z}];(* all evaluated points *)
f[x, y, z] - g[x, y, z]]},
Mesh -> {{0.}},(* intersection *)
MeshStyle -> Directive[Red, Thick],
PlotLegends -> {f, g}],
LineLegend[{Red}, {"f\[ThinSpace]=\[ThinSpace]g"}]]];

Show[cp3d]


Selecting the reaped points that are at the intersection (and eliminating points with duplicate values of x)

pts = DeleteDuplicates[
Select[Sort@reaped[[2, 1]],
Abs[f @@ #] < 10^-4 && Abs[g @@ #] < 10^-4 &],
Abs[#1[[1]] - #2[[1]]] < 10^-6 &];

{xmin, xmax} = MinMax@pts[[All, 1]]

(* {5.80816, 6.28319} *)


In the original response, for simplicity the color of the ListLinePlot was determined by the value of x and only loosely on the value of z. To determine the color based on the value of z, define z as a function of x. This is done using a linear Interpolation (the Interpolation is why points with duplicate values of x had to be eliminated).

zfx = Interpolation[pts[[All, {1, 3}]],
InterpolationOrder -> 1];

{zmin, zmax} = Reverse[zfx /@ {xmin, xmax}]

(* {0.000234482, 1.49426} *)

ListLinePlot[Most /@ pts,
PlotRange -> {{5.6, 2 Pi}, {-3/20, 0}},
PlotStyle -> Thick,
ColorFunction ->
(ColorData["Rainbow"][Rescale[zfx@#1, {zmin, zmax}]] &),
ColorFunctionScaling -> False,
PlotLegends -> BarLegend[{ColorData["Rainbow"],
{zmin, zmax}},
LegendLabel -> Style[z, 14, Bold]],
Frame -> True,
FrameLabel -> (Style[#, 14, Bold] & /@ {x, y}),
PlotLabel -> Style[StringForm[" = ",
HoldForm@f[x, y, z], HoldForm@g[x, y, z]], 14, Bold]]


• Thanks again for the edit, but, I think the problem still persists, I have added the plot I get I mentioned in my previous comment, it seems that again the LegendBar does not match with the curve; the LegendBar is almost red, but the curve is almost blue.
– user80187
Commented May 27, 2021 at 21:34
• Post a new question and include your code. We cannot tell from looking at a plot what exactly you did to produce it. However, what looks suspect is that the legend indicates that z is varying from 0 to about 3 but the plot range is supposed to be restricted to 0 < z < 3/2 Commented May 27, 2021 at 21:37
• I do not use a different code to write it again, I have only changed the domain of $z$. I have added the code at the end of the question (it is your code; I have only changed 0<z<\pi). I am sorry, I am not very familiar with Mathematica.
– user80187
Commented May 27, 2021 at 21:53
• If you change the range of z to 0 < z < Pi, the solution does not work since the intersection is essentially vertical, i.e., there are not unique values of z for values of x`. I would guess that you would need to find a parametric representation since it cannot be represented as a function. Commented May 27, 2021 at 22:41
• Thank you again. In that case, there is a problem at $z=0,\pi$. As I had written in the text, I was looking for a way to find the solution by changing $z$ with the step $0.001$. I will probably ask a new question later. I really appreciate your time and answer.
– user80187
Commented May 27, 2021 at 22:52