# Plot real zeros regions of the polynomial

Good morning everyone! One problem have appeared. I'm trying to plot regions with different number of real zeros of the polynomial. I have this code:

k = 2
EE = 0
\[Epsilon] = 1
pyz =  1
pt = Sqrt[1]
Clear[r]
poly = r^4/
pyz^2 (pt^2 + (r^((-2 (4 k^2 - 3 k + 2))/((k - 1) (2 k -
1))) ((pt^2 - (pyz^2 + pyz^2) - \[Epsilon]*r^2) r^((4 k)/(
k - 1)) + (pyz^2 + pyz^2 + \[Epsilon]*r^2)*r^(5/(k - 1))) +
EE))
zero1d = r /. NSolve[poly == 0, r, Reals]
NumberLinePlot[zero1d]
RegionPlot[Length[zero1d] > 0, {pt, 0.0001, 100}, {pyz, 0.0001, 100}]


Thus, I could see the number of real zeros. I need to plot shaded regions for which I have 0,1,2,3,4 real positive zeros in the plane $$p_t$$-$$p_{yz}$$ (this values run from 0 to arbitrary value). But I have no thoughts how to do it. Maybe someone could help me? I think there could be used regionplot. Any help will be appreciated. Best regards.

Tried this:

k = 2;
EE = 0;
\[Epsilon] = 1;

poly[r_] :=
r^4/pyz^2 (pt^2 + (r^((-2 (4 k^2 - 3 k + 2))/((k - 1) (2 k -
1))) ((pt^2 - (pyz^2 + pyz^2) - \[Epsilon]*
r^2) r^((4 k)/(k - 1)) + (pyz^2 +
pyz^2 + \[Epsilon]*r^2)*r^(5/(k - 1))) + EE));

atLeastOne = Exists[r, r > 0  &&  poly[r] == 0];
atLeastTwo =  Exists[{r1, r2}, r1 > 0  &&  r2 > 0   &&  r1 != r2
&& poly[r1] == 0   && poly[r2] == 0];

atLeastThree =
Exists[{r1, r2, r3},
r1 > 0  &&  r2 > 0    &&  r3 > 0    &&  r1 != r2  != r3  &&
poly[r1] == 0   && poly[r2] == 0 && poly[r3] == 0];

atLeastFour =
Exists[{r1, r2, r3, r4},
r1 > 0  &&  r2 > 0    &&  r3 > 0    &&  r4 > 0   &&
r1 != r2  != r3  != r4 && poly[r1] == 0   && poly[r2] == 0 &&
poly[r3] == 0 && poly[r4] == 0]


The code

RegionPlot[Evaluate[Reduce[atLeastTwo, Reals],{pt, 0, 100}, {pyz, 0, 100}]


should give the region where the polynomial poly[r] has at least 2 distinct positive real roots. The same goes for atLeastOne, atLeastThree and atLeastFour. By the looks of it, the number of zeroes of the polynomial that are positive is always 1.