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

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.

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 *)
]

• Your answer contain more useful information then me. Commented Nov 12, 2021 at 1:08
• Where did you learn to make this combo of MeshStuff? I've read the documentation but each one seems to be made to do an specific thing, you managed to make them work together. I am in awe in here. Commented Nov 17, 2021 at 0:39
• @RedBanana Thanks! Actually I learned from the documentation pages for the three options and from fiddling around. Commented Nov 17, 2021 at 3:44
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}]]


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]}]]


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 = DeveloperToPackedArray@ (* 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@ NDSolveFiniteDifferenceDerivative[2,
data[[All, 1]],
data[[All, 2]], DifferenceOrder -> 1
] ]]
]


NDSolveFiniteDifferenceDerivative 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.