How to list the content of the function and derivative function according to the derivative function automatically generates the corresponding table?

Question

ClearAll["Global`*"];
(*Define the function*)
f[x_] := 1/3 x^3 - 4 x + 4;
(*Specify the domain of the function*)
functionDomain =FunctionDomain[f[x], x];
(*Calculate the first-order derivative of the function*)
firstOrderDerivative = D[f[x], x] // FullSimplify // Factor;
(*Determine increasing and decreasing intervals of the function*)
increasingInterval = 
 Reduce[D[f[x], x] > 0 && functionDomain, x, Reals] // FullSimplify //
   Reduce
decreasingInterval = 
 Reduce[D[f[x], x] < 0 && functionDomain, x, Reals] // FullSimplify //
   Reduce

Through the above code, it is possible to calculate the monotonically increasing intervals and monotonically decreasing intervals of a function within its corresponding domain.

My goal is to automatically generate a table in the following format based on the monotonicity of the function.

How can the above table be automatically generated?

The table should have three rows:

The first row is for the range of x, ensuring that the interval endpoints are arranged from small to large. Each interval corresponds to the monotonically increasing or decreasing interval of the function, with the interval delimiters listed separately.

The second row indicates the sign of the derivative function, that is, the positivity or negativity of the derivative function in the corresponding interval.

The third row shows the monotonicity of the function in that interval, using an upward arrow for monotonically increasing and a downward arrow for monotonically decreasing.

If the function has different monotonicities on both sides of the interval delimiter, then the function has a local maximum at that point, which should be automatically calculated and displayed in the corresponding cell of the table.

The table can be adaptively matched and filled for any function.

I tried it myself, but it's not the effect I want.

ClearAll["Global`*"];

f[x_] := 1/3  x^3 - 4  x + 4;

functionDomain = FunctionDomain[f[x], x];

firstOrderDerivative = D[f[x], x] // FullSimplify // Factor;

increasingInterval = 
 Reduce[D[f[x], x] > 0 && functionDomain, x, Reals] // FullSimplify //
   Reduce
decreasingInterval = 
 Reduce[D[f[x], x] < 0 && functionDomain, x, Reals] // FullSimplify //
   Reduce
interval = increasingInterval || decreasingInterval // Sort
Length[interval]
Table[interval[[i]], {i, 1, Length[interval]}]
Transpose[{{"x", "f'(x)", 
    "f(x)"}, {Table[interval[[i]], {i, 1, Length[interval]}], 
    functionDomain, allZeroPoints}}] // 
 Grid[#, Dividers -> All, Frame -> All, ItemStyle -> {Bold, Bold}] &

Answer 1

$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

table[func_, sym : _Symbol : x, 
  intvl : _List : {-Infinity, Infinity}] := 
 Module[{crpt, int, arg, df},
  df = D[func, sym];
  crpt = SolveValues[{df == 0,
     sym ∈ If[intvl === {-Infinity, Infinity}, Reals, Interval[intvl]]},
    sym];
  int = Partition[{Min[intvl], crpt, Max[intvl]} // Flatten, 2, 
     1] //. {s___, {a_, b_}, {b_, c_}, e___} :>
     {s, {a, b}, b, {b, c}, e};
  arg = int /. {{-Infinity, lb_} :> lb - 1, {ub_, Infinity} :> 
      ub + 1, {a_, b_} :> (a + b)/2};
  {{"", StringForm["`` = ``", TraditionalForm@HoldForm[f[x]], 
      TraditionalForm[func /. sym -> x]],
     SpanFromLeft},
    Prepend[int, TraditionalForm@x],
    Prepend[((df /. sym -> #) & /@ arg) /. {_?Positive -> Style["+", 20],
       _?Negative -> Style["-", 20]}, TraditionalForm@HoldForm[f'[x]]],
    Prepend[
     If[(df /. sym -> #) > 0, Style["↗", 20, Red, Bold],
        If[(df /. sym -> #) < 0, Style["↘", 20, Red, Bold], 
         func /. sym -> #]] & /@ arg,
     TraditionalForm@HoldForm[f[x]]]} //
   Grid[#, Frame -> All,
     ItemSize -> All,
     Background -> {{LightBlue}, None}] &]

Examples:

f[x_] := 1/3  x^3 - 4 x + 4;

table[f[x]]

table[Sin[x], x, {0, 8}]