2
$\begingroup$

Graph

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}]
$\endgroup$
1
  • $\begingroup$ 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 :) $\endgroup$
    – Domen
    May 3, 2023 at 5:28

3 Answers 3

8
$\begingroup$
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@
 MapThread[
  Plot[#1
    , {x, 0, 12}
    , PlotRange -> {1.6, 3.2}
    , Mesh -> {#2}
    , MeshShading -> {Dotted, Automatic, Dashed}
    , PlotStyle -> #3
    , ImageSize -> 400
    ] &
  , {funcs, flatAt, styles}
  ]

enter image description here

$\endgroup$
3
  • $\begingroup$ 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 $\endgroup$
    – user444
    May 3, 2023 at 7:20
  • 2
    $\begingroup$ 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. $\endgroup$
    – Syed
    May 3, 2023 at 7:23
  • $\begingroup$ I have asked another question mathematica.stackexchange.com/q/284600/84456 $\endgroup$
    – user444
    May 3, 2023 at 7:50
4
$\begingroup$

Using ConditionalExpression

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

enter image description here

$\endgroup$
4
$\begingroup$
funcs = Function[x, #] & /@ {2 + Sinc[x], 2 + Sinc[0.9 x], 2 + Sinc[0.8 x]};

styles = {Red, Blue, Black};

meshshading = {Dashing[{}], Dashed, DotDashed};


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


gridlines = Join @@ MapThread[Thread @* List][{xMesh[0, 10] /@ funcs, styles}];

Show[MapThread[
   Plot[# @ x, {x, 0, 10}, 
     Mesh -> {xMesh[0, 10] @ #}, 
     PlotStyle -> #2,  
     MeshShading -> meshshading] &] @
  {funcs, styles}, 
 GridLines -> {gridlines, None}, 
 PlotRange -> {1.6, 3.2}, AxesOrigin -> {0, 1.6}]

enter image description here

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.