How to optimize the code that draws the original function and its derivative function into the same coordinate system?

Question

ClearAll@f;    
f[x_] := Log[x]/x
Manipulate[Refresh[functions = Table[D[f[x], {x, n}], {n, 0, nMax, 1}];
  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, 0, 3}, PlotLabels -> labels, ImageSize -> 700, 
  AspectRatio -> 1, 
  PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,
   PopupMenu}]

The function and derivative are drawn in the same coordinate system

Answer 1

ClearAll["`*"];     
f[x_] := x E^x + 1/2 - E^x + x^3/3
xr = -2 <= x <= 2
Maximize[{f[x], xr}, x]
Minimize[{f[x], xr}, x]
sol1 = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] > 0, xr}, x]
sol2 = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] < 0, xr}, x]
Manipulate[Refresh[functions = Table[D[f[x], {x, n}], {n, 0, nMax, 1}];
  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, -2, 2}, 
  Epilog -> {AbsolutePointSize[10], Green, Point[{x, f[x]} /. sol2], 
    Red, Point[{x, f[x]} /. sol1]}, PlotLabels -> labels, 
  ImageSize -> 700, AspectRatio -> 1, 
  PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,
   PopupMenu}] 

ClearAll["`*"];     
f[x_] := x E^x + 1/2 - E^x + x^3/3
xr = -2 <= x <= 2
gmax = Maximize[{f[x], xr}, x]
gmin = Minimize[{f[x], xr}, x]
lmin = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] < 0, xr}, x]
lmax = Solve[{D[f[x], x] == 0, D[f[x], {x, 2}] > 0, xr}, x]
Manipulate[Refresh[functions = Table[D[f[x], {x, n}], {n, 0, nMax, 1}];
  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, -2, 2}, 
  Epilog -> {{Darker@Green, AbsolutePointSize[20], 
     Point[{x, f[x]} /. gmax[[2]]], AbsolutePointSize[16], White, 
     Point[{x, f[x]} /. gmax[[2]]]}, {Darker@Red, 
     AbsolutePointSize[20], Point[{x, f[x]} /. gmin[[2]]], 
     AbsolutePointSize[16], White, Point[{x, f[x]} /. gmin[[2]]]}, 
    AbsolutePointSize[8], Green, Point[{x, f[x]} /. lmin], Red, 
    Point[{x, f[x]} /. lmax]}, PlotLabels -> labels, ImageSize -> 700,
   AspectRatio -> 1, 
  PlotLabel -> Row[{"f(x) = ", f[x]}]], {{nMax, 1, "Order"}, 1, 10, 1,
   PopupMenu}]