0
$\begingroup$ 
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 = 
   MapThread[#1 <> " = " <> ToString[#2, TraditionalForm] &, {orders, 
     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,
   PopupMenu}]

enter image description here

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 = 
   MapThread[#1 <> " = " <> ToString[#2, TraditionalForm] &, {orders, 
     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,
   PopupMenu}]

enter image description here

Improve this question
$\endgroup$
3
  • 2
    $\begingroup$ 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. $\endgroup$
    – Nasser
    Commented Jun 6, 2023 at 23:46
  • $\begingroup$ 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. $\endgroup$
    – csn899
    Commented Jun 6, 2023 at 23:51
  • 1
    $\begingroup$ Probably there's a solution on site since there's one for the second derivative, which you might adapt: mathematica.stackexchange.com/questions/258120/… $\endgroup$
    – Michael E2
    Commented Jun 6, 2023 at 23:59

1 Answer 1

Reset to default
4
$\begingroup$

Replace {functions} in the first argument of Plot with

Evaluate @ Append[functions, 
   Style[ConditionalExpression[functions[[2]], functions[[2]] <= 0], Cyan]]

to get

enter image description here

Replace Cyan with Directive[White, Dashed] to get

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.