1
$\begingroup$

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

Based on Michael E2's comments in the above post, the following code and images are obtained:

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], 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, MeshFunctions -> {f'}, 
  Mesh -> {{0}}, MeshShading -> {Red, Blue}, 
  PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,
   PopupMenu}]

enter image description here

The colors of the first derivative function in the image obtained from the above code are different on and below the x-axis. The colors of the monotonically increasing and decreasing parts of the original function are different. But the colors between them are consistent and difficult to distinguish.

My requirements are:

The image of the first derivative function has different colors on the x-axis and is represented by two different colors. The colors of all images above and below the x-axis are the same.

The image of the original function is represented by two different colors in the monotonically increasing and monotonically decreasing parts, with the colors of the monotonically increasing and monotonically decreasing parts being the same.

Then the first derivative function and the original function use two different colors.

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[{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], 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, MeshFunctions -> {f'}, 
  Mesh -> {{0}}, 
  MeshShading -> {Dynamic[
     Directive[Darker[CurrentValue["Color"]], AbsoluteThickness[3]]], 
    Automatic}, 
  PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,
   PopupMenu}]

Why do the labels of the functions overlap after running?

enter image description here

$\endgroup$

1 Answer 1

4
$\begingroup$

Replace MeshShading -> {Red, Blue} with MeshShading -> {Dashed, Automatic} to get

enter image description here

Use

MeshShading ->
   {Dynamic[Directive[Darker[CurrentValue["Color"]],
       Dashed, AbsoluteThickness[3]]], 
    Automatic}

to get

enter image description here

$\endgroup$
4
  • $\begingroup$ Why do the labels of the functions overlap after running?I have updated the main post as shown in the picture $\endgroup$
    – csn899
    Commented Jun 7, 2023 at 3:45
  • $\begingroup$ it might be a version/os related issue. I don't get that on 13.1.0 for Linux x86 (64-bit) $\endgroup$
    – kglr
    Commented Jun 7, 2023 at 3:51
  • $\begingroup$ do you get the same problem if you use MeshShading -> {Dashed, Automatic}? $\endgroup$
    – kglr
    Commented Jun 7, 2023 at 4:04
  • $\begingroup$ get the same problem. $\endgroup$
    – csn899
    Commented Jun 7, 2023 at 4:27

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.