# Slope-demarcated PlotStyle implementation

In the above graph, I would like to display plots with slope-dependent plot styles (solid, dashed and dotted).

Specifically, the regions a---b1, a---b2 and a---b3 with solid lines(Thick), then b1---c1, b2---c2 and b3---c3 with Dashed lines and beyond c1, c2 and c3 with DotDashed lines.

Is there a way to do this in a automated fashion without putting the coordinate points manually?

I'm using Mathematica 12.0.

The following code generates the above graph:

Plot[{2 + Sinc[x], 2 + Sinc[0.9 x], 2 + Sinc[0.8 x]}, {x, 0, 10},
PlotStyle -> {Red, Blue, Black}, PlotRange -> {1.6, 3.2}]

• Why should lines beyond c be DotDashed if they have the same (negative) slope as the regions a–b which are Thick? This does not completely correspond to the title of your question :) May 3, 2023 at 5:28

Clear["Global*"];

g[f_] := FindRoot[D[f, x], {x, #}] & /@ Range[-0.11, 10, 1] //
Values // Chop // Flatten;
funcs = {2 + Sinc[x], 2 + Sinc[0.9 x], 2 + Sinc[0.8 x]};
flatAt = g /@ funcs // Map[Chop] // Map[Round[#, 0.0001] &] //
Map[Union] // Map[Select[# >= 0 &]] // Map[Take[#, 3] &];
styles = {Red, Darker@Green, Blue};

Show@
Plot[#1
, {x, 0, 12}
, PlotRange -> {1.6, 3.2}
, Mesh -> {#2}
, MeshShading -> {Dotted, Automatic, Dashed}
, PlotStyle -> #3
, ImageSize -> 400
] &
, {funcs, flatAt, styles}
]


• Thank you. It's beautiful. However, I want to know what I should do if I have to plot the same thing without the functions but with data table May 3, 2023 at 7:20
• That will be a separate question. It will involve making a smooth function by interpolating the points and then you can use it to find slopes. It depends on the highest frequency in your data. It is hard to generalize answers to such problems.
– Syed
May 3, 2023 at 7:23
• I have asked another question mathematica.stackexchange.com/q/284600/84456 May 3, 2023 at 7:50
Clear["Global*"]

funcs = {2 + Sinc[x], 2 + Sinc[0.9 x], 2 + Sinc[0.8 x]} // Rationalize;

minPts = {#[[2, 1, -1]], #[[1]]} & /@
(Minimize[{#, 0 < x < 10}, x] & /@ funcs);

maxPts = {#[[2, 1, -1]], #[[1]]} & /@
(Maximize[{#[[1]], #[[2]] < x < 10}, x] & /@
Transpose[{funcs, minPts[[All, 1]]}]);

colors = {Red, Blue, Darker@Green};

lines = {Automatic, Dashed, Dotted};

styles = Flatten[Outer[{#1, #2} &, lines, colors], 1];

funcs2 = Flatten[
Transpose[
Tooltip[#, #[[1]]] & /@ {
ConditionalExpression[#[[1]], 0 <= x <= #[[2]]],
ConditionalExpression[#[[1]], #[[2]] < x <= #[[3]]],
ConditionalExpression[#[[1]], #[[3]] < x <= 10]} & /@
Transpose[{funcs, minPts[[All, 1]], maxPts[[All, 1]]}]]];


Plotting,

Plot[Evaluate@funcs2, {x, 0, 10},
PlotRange -> {1.6, Automatic},
PlotStyle -> styles,
AxesLabel -> {Style[x, 14], None},
Epilog -> {AbsolutePointSize[4],
{#[[1]], Tooltip[Point[#[[2]]], N[#[[2]]]],
Text[#[[3]], #[[2]], {0, 2}]} & /@
Transpose[{colors, minPts, Subscript["b", #] & /@
Range[Length@funcs]}],
{#[[1]], Tooltip[Point[#[[2]]], N[#[[2]]]],
Text[#[[3]], #[[2]], {0, -2}]} & /@
Transpose[{colors, maxPts, Subscript["c", #] & /@
Range[Length@funcs]}]}]


funcs = Function[x, #] & /@ {2 + Sinc[x], 2 + Sinc[0.9 x], 2 + Sinc[0.8 x]};

styles = {Red, Blue, Black};

ClearAll[xMesh]
xMesh[from_, to_] := NSolveValues[{#'[t] == 0, from <= t < to}, t] &


Replace {x, 0, 10} with {x, 0, 20} and xMesh[0, 10] with xMesh[0, 20] (and add the option PlotRange -> All to Plot[...]) to get