Plot that changes color depending on whether $f''[x]<0$?

Question

I am trying to make a plot such as the following one:

Which I achieved with the following code:

f[x_] := Sin[x] x^2
g[x_] := If[f''[x[[1]]] <= 0, {Red, Point[x]}, {Blue, Point[x]}]
Graphics[g /@ Table[{x, f[x]}, {x, -2 Pi, 2 Pi, 0.1}], AspectRatio -> 1]

It takes the points where the $f''[x]\leq 0$, paints them red, and paints them blue otherwise.

Question: Is it possible to make this with Plot[]? I'd like to do this with a continuous line instead.

Answer 1

A MeshFunctions way:

f[x_] := Sin[x] x^2;
Plot[f[x], {x, -2 Pi, 2 Pi},
 MeshFunctions -> {f''},
 Mesh -> {{0}},              (* crossing f''[x] == 0, neg -> pos, *)
 MeshShading -> {Red, Blue}  (* changes color Red-> Blue *)
 ]

Answer 2

f[x_] := Sin[x] x^2

Legended[
 Plot[f[x], {x, -2 Pi, 2 Pi},
  ColorFunction ->
   Function[{x, y}, If[f''[x] <= 0, Red, Blue]],
  ColorFunctionScaling -> False,
  PlotPoints -> 50,
  MaxRecursion -> 5,
  AxesLabel ->
   (Style[#, 12, Bold] & /@ {x, HoldForm@f[x]})],
 Placed[
  LineLegend[{Blue, Red},
   {HoldForm[f''[x] > 0],
    HoldForm[f''[x] <= 0]}],
  {0.7, 0.75}]]

EDIT: Including the plot of f''[x] for comparison

Legended[
 Plot[{f[x], f''[x]}, {x, -2 Pi, 2 Pi},
  PlotStyle -> {Automatic, Dashed},
  PlotLabels -> Placed["Expressions", Below],
  ColorFunction ->
   Function[{x, y}, If[f''[x] <= 0, Red, Blue]],
  ColorFunctionScaling -> False,
  PlotPoints -> 50,
  MaxRecursion -> 5,
  AxesLabel ->
   (Style[#, 12, Bold] & /@ {x, ""})],
 Placed[
  LineLegend[{Blue, Red},
   {HoldForm[f''[x] > 0],
    HoldForm[f''[x] <= 0]}],
  {0.7, 0.85}]]

Answer 3

Yet another way:

f[x_] := Sin[x] x^2

Plot[Evaluate[ConditionalExpression[f[x], #] & /@ 
    {f''[x] > 0, f''[x] <= 0}], 
 {x, -2 Pi, 2 Pi},
 ImageSize -> Large,
 PlotStyle -> (Directive[#, Thick] & /@ {Blue, Red}),
 PlotLegends -> LineLegend[
   Style[#, 16] & /@ {Defer[f''[x] > 0], Defer[ f''[x] <= 0]}]] 

Answer 4

Via numerical post-processing, which would work on data when symbolic derivatives are unavailable:

f[x_] := Sin[x] x^2;
graph = Plot[f[x], {x, -2 Pi, 2 Pi}];
colors = Developer`ToPackedArray@ (* red/purple/blue *)
  {{1., 0., 0}, {0.5, 0., 0.5}, {0., 0., 1.}};
graph /. Line[data_?MatrixQ] :>
  Line[data, VertexColors ->
    colors[[2 +   (* offset + sign = index to colors *)
       Sign@ NDSolve`FiniteDifferenceDerivative[2,
         data[[All, 1]], 
         data[[All, 2]], DifferenceOrder -> 1
         ] ]]
   ]

NDSolve`FiniteDifferenceDerivative is documented in the tutorial The Numerical Method of Lines.

Note: A difference between VertexColors/ColorFunction based solutions and MeshFunctions/separate-graph (@kglr's) solutions is whether the graphics are rasterized or converted to vector graphics when exported to PDF: The graphics including the labels are rasterized when VertexColors is present, and they are converted to vector graphics in the MeshFunctions case. If vector graphics are needed for plotting data, then the easiest way would be to create a "symbolic" function using f = Interpolation[data]. Then one can use f'' for @kglr's method or MeshFunctions as in my other answer.