# How to modify this code so that the first derivative image of the function displays different colors above and below the x-axis?

ClearAll["*"];
f[x_] := x^3 - 5 x - 10
D[f[x], x] // FullSimplify
xr = -5 <= x <= 5
Solve[D[f[x], x] == 0, x, Reals]
NSolve[D[f[x], x] == 0 && xr, x, Reals]
gmax = Maximize[{f[x], xr}, x]
gmin = Minimize[{f[x], xr}, x]
lmax = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] < 0, xr}, x]
lmaxv = {x, f[x]} /. lmax[[1]] // FullSimplify
lmin = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] > 0, xr}, x]
lminv = {x, f[x]} /. lmin[[1]] // FullSimplify
Manipulate[
Refresh[functions =
Table[D[f[x], {x, n}], {n, 0, nMax, 1}] // FullSimplify;
orders =
Table[D[f[x], {x, n}] // Inactivate // TraditionalForm //
ToString, {n, 0, nMax, 1}];
labels =
functions}];];
Plot[{functions}, {x, -5, 5},
Epilog -> {{Darker@Purple, AbsolutePointSize[10],
Point[{x, f[x]} /. gmax[[2]]], AbsolutePointSize[7], Red,
Point[{x, f[x]} /. gmax[[2]]]}, {Darker@Red,
AbsolutePointSize[10], Point[{x, f[x]} /. gmin[[2]]],
AbsolutePointSize[7], Black, Point[{x, f[x]} /. gmin[[2]]]},
AbsolutePointSize[8], Green, Point[{x, f[x]} /. lmin], Red,
Point[{x, f[x]} /. lmax]}, PlotLabels -> labels,
AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y},
ImageSize -> Full, AspectRatio -> 1,
PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,


How to modify this code so that the first derivative image of the function displays different colors above and below the x-axis?

Update 1 based on kglr:

ClearAll["*"];
f[x_] := x^3 - 5 x - 10
D[f[x], x] // FullSimplify
xr = -5 <= x <= 5
Solve[D[f[x], x] == 0, x, Reals]
NSolve[D[f[x], x] == 0 && xr, x, Reals]
gmax = Maximize[{f[x], xr}, x]
gmin = Minimize[{f[x], xr}, x]
lmax = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] < 0, xr}, x]
lmaxv = {x, f[x]} /. lmax[[1]] // FullSimplify
lmin = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] > 0, xr}, x]
lminv = {x, f[x]} /. lmin[[1]] // FullSimplify
Manipulate[
Refresh[functions =
Table[D[f[x], {x, n}], {n, 0, nMax, 1}] // FullSimplify;
orders =
Table[D[f[x], {x, n}] // Inactivate // TraditionalForm //
ToString, {n, 0, nMax, 1}];
labels =
functions}];];
Plot[Evaluate@
Append[functions,
Style[ConditionalExpression[functions[[2]], functions[[2]] <= 0],
RGBColor[1, 0, 1]]], {x, -5, 5},
Epilog -> {{Darker@Purple, AbsolutePointSize[10],
Point[{x, f[x]} /. gmax[[2]]], AbsolutePointSize[7], Red,
Point[{x, f[x]} /. gmax[[2]]]}, {Darker@Red,
AbsolutePointSize[10], Point[{x, f[x]} /. gmin[[2]]],
AbsolutePointSize[7], Black, Point[{x, f[x]} /. gmin[[2]]]},
AbsolutePointSize[8], Black, Point[{x, f[x]} /. lmin], Red,
Point[{x, f[x]} /. lmax]}, PlotLabels -> labels,
AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y},
ImageSize -> Full, AspectRatio -> 1,
PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,


• Your code gives error when run as is on V 13.2.1, here is a screen shot !Mathematica graphics also, it would be better to make a smaller example of what you want to do instead of larger code to make it easier to understand. Jun 6 at 23:46
• The function has been replaced because the code calculates the global maximum and global minimum values of the function within a certain interval. local Maximum and local minimum values. But not all functions have corresponding values, so there may be errors. Now that I have corrected it, there is no problem with this error report. Jun 6 at 23:51
• Probably there's a solution on site since there's one for the second derivative, which you might adapt: mathematica.stackexchange.com/questions/258120/… Jun 6 at 23:59

Replace {functions} in the first argument of Plot with
Evaluate @ Append[functions,

Replace Cyan with Directive[White, Dashed] to get