2
$\begingroup$

By running the following code:

f[x_] = Piecewise[{
  {1/2 x, 0 <= x <= 2},
  {-5 x^2 + 31 x - 41, 2 <= x <= 4},
  {-3/2 x + 9, 4 <= x <= 6},
  {3 x - 18, 6 <= x <= 8},
  {-3/2 x + 18, 8 <= x <= 10}}];

g[x_] = Piecewise[{
  {f[x - 1/5], f'[x] < 0},  
  {f[x + 1/5], f'[x] > 0}}];

Plot[
  {f[x], g[x]},
  {x, 0, 10},
  AxesLabel -> {x, y},
  PlotStyle -> {Dashed, Thick}]

I get the following graph:

Unfortunately it's not exactly what I want. I would like to get this other graph (for now I got with Paint):

enter image description here

Could someone kindly write me a code to get into what Wolfram Mathematica?

Thank you!

$\endgroup$
2
  • $\begingroup$ Can you simply find out the maximum value using Maximize and then create another function? Or you want this process automated? $\endgroup$
    – Wjx
    Commented Jul 25, 2016 at 23:38
  • $\begingroup$ try doing like this g[x_] = Piecewise[{ {{x+1/5,f[x]}, f'[x] < 0}, .. and use ParametricPlot $\endgroup$
    – george2079
    Commented Jul 26, 2016 at 0:04

2 Answers 2

3
$\begingroup$

Your idea is to pick a value to the left if the function is decreasing and a value to the right if the function is increasing because then you'll get a value that's slightly larger. In order to get the flat line over the tops you might instead look for the maximum value in the neighborhood of the current position, it will be the same for the increasing and decreasing parts but will be the maximum in the neighborhood of the maximum.

pts = Table[f[x], {x, -0.75, 10.75, 0.001}];
pts = Max /@ Partition[pts, 1000, 100];

Show[
 Plot[f[x], {x, 0, 10}, AxesLabel -> {x, y}, PlotStyle -> {Dashed, Thick}],
 ListLinePlot[pts, DataRange -> {0, 10}, PlotStyle -> {Thick, ColorData[97][2]}]
 ]

Mathematica graphics

Looking for the maximum of f with constraints at every plot point was time consuming, so instead I evaluate the function at a bunch of points and use those to find the approximate maximum in the neighborhood of width 1 around the plot point.

$\endgroup$
0
0
$\begingroup$

It is rather slow, but you can define

g[x_?NumericQ] := Module[{e}, MaxValue[{f[x + e], -1/5 <= e <= 1/5}, e]]
Plot[{f[x], g[x]}, {x, 0, 10}]

giving

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.