3
$\begingroup$

Writing:

f[x_] := Piecewise[{{6.83 - 12.66 x + 3.88 x^2, 2.59 < x < 3.10}, 
                    {188.44 - 61.81 x + 4.88 x^2, 3.73 < x < 5.1}, 
                    {51.06 - 79.00 x + 20.25 x^2, 0 < x < 0.82}, 
                    {48.51 - 76.87 x + 20.25 x^2, 3.10 < x < 3.6}, 
                    {671.66 - 285.97 x + 30.25 x^2, 3.6 < x < 3.73}, 
                    {0, True}}]

g[x_] := Piecewise[{{6.83 - 12.66 x + 3.88 x^2, 0.68 < x < 0.82}, 
                    {51.06 - 79.00 x + 20.25 x^2, 1.2 < x < 3.08}, 
                    {48.51 - 76.88 x + 20.25 x^2, 0.82 < x < 1.2}, 
                    {594.35 - 270.81 x + 30.25 x^2, 3.85 < x < 5.1}, 
                    {0, True}}]

Plot[{f[x], g[x]}, {x, 0, 5.1}, PlotStyle -> {Red, Gray}]

I get:

enter image description here

So far everything is ok.

Now I would like to get the following plot (blue color) translated:

enter image description here

where in yellow I have indicated the characteristic points in which we must translate the points of the plots of f and g by t = 0.24.

I'm looking for a concise way to track the blue plot in an automated way by knowing f, g and t.


@kglr: thank you for your precious contribution!

Could you apply your technique in the following way?

enter image description here


@kglr: thanks again for the immense help, it is precisely what interests me!

Unfortunately, though, if I write:

f[x_] := Piecewise[{{12.09 x + 4.88 x^2, 0 < x < 1.37}, 
                    {-22.58 x + 30.25 x^2, 1.37 < x < 1.5}, 
                    {183.14 - 129.67 x + 20.25 x^2, 1.5 < x < 2.00}, 
                    {43.03 - 26.86 x + 3.88 x^2, 2.00 < x < 2.51}, 
                    {174.86 - 127.55 x + 20.25 x^2, 4.28 < x < 5.1}, 
                    {0, True}}]

g[x_] := Piecewise[{{-37.74 x + 30.25 x^2, 0 < x < 1.25}, 
                    {174.86 - 127.55 x + 20.25 x^2, 2.02 < x < 3.90}, 
                    {183.14 - 129.67 x + 20.25 x^2, 3.90 < x < 4.28}, 
                    {43.03 - 26.86 x + 3.88 x^2, 4.28 < x < 4.42}, 
                    {0, True}}]

I get:

enter image description here

where the horizontal piece on the right is missing and the blue color is on the contrary. If you could solve it it would be great!

$\endgroup$
2
  • 1
    $\begingroup$ The gray graph seems to be translated away from the minima (translating the segment up to the adjacent maxima) and the red graph translated away from the maxima (translating the segment up to the adjacent minima). Does that seem accurate? What's supposed to happen if two translated segments overlap? $\endgroup$
    – Michael E2
    Commented Aug 16, 2018 at 12:01
  • 1
    $\begingroup$ So the translated parts are always separated by a horizontal segment on the x-axis (f[x] == 0) of length > 2t = 2 * 0.24? (Just how specific or general a problem is helps to formulate a good solution.) $\endgroup$
    – Michael E2
    Commented Aug 16, 2018 at 12:20

2 Answers 2

3
$\begingroup$

You can post-process the Plot outputs to translate the graphics primitives based on the sign of the derivative:

ClearAll[tr, postprocess]
tr[f_, t_] := TranslationTransform[{-t Sign[f'[#[[1]]]], 0}][#] & ;
postprocess[fill_: False][o : OptionsPattern[]] := Show[Module[{tpts, pr = PlotRange @ #,
  pts = SortBy[Join @@ Cases[# /. Line[{{_, y_} ..}] :> {}, Line[x_] :> x, ∞], First]}, 
 tpts = Join[{{pr[[1, 1]], #[[1, 2]]}}, #, {{pr[[1, 2]], #[[-1, 2]]}}] & @
    DeleteDuplicates[tr[#2, #3] /@ pts]; 
 Graphics[{#4, Thick, Line @ tpts, fill /. {False -> {}, 
     True -> {Opacity[.3], 
      Polygon[Join[{{tpts[[1, 1]], 0}}, tpts, {{tpts[[-1, 1]], 0}}]]}}},
    Options[#]]] & @@@ #, PlotRange -> All, o] &; 

Examples:

{plot1, plot2} = Plot[#[x], {x, 0, 5.1}, PlotStyle -> #2, BaseStyle -> Thick] & @@@ 
   Transpose[{{f, g}, {Red, Gray}}];

t = .24;
Show[postprocess[][AxesOrigin -> {0, -30}, Frame -> True, ImageSize -> 600]@
  {{plot1, f, t, Directive[Blue, Dashed]}, {plot2, g, -t, Green}}, 
  plot1, plot2]

enter image description here

postprocess[True][Frame -> True, ImageSize -> 600]@
 {{plot1, f, t, Directive[Blue, Dashed]}, {plot2, g, -t, Green}}

enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ @TeM, i will post an update if I figure out a clean way to handle the fillings. $\endgroup$
    – kglr
    Commented Aug 17, 2018 at 8:08
  • 1
    $\begingroup$ @TeM, please see the new version. $\endgroup$
    – kglr
    Commented Aug 17, 2018 at 9:00
  • 1
    $\begingroup$ @TeM, updated with a fix. $\endgroup$
    – kglr
    Commented Aug 17, 2018 at 10:00
2
$\begingroup$

You can use the functions themselves and build a new function from them, for example:

    f[x_] := Piecewise[{{6.83 - 12.66 x + 3.88 x^2, 
        2.59 < x < 3.10}, {188.44 - 61.81 x + 4.88 x^2, 
        3.73 < x < 5.1}, {51.06 - 79.00 x + 20.25 x^2, 
        0 <= x < 0.82}, {48.51 - 76.87 x + 20.25 x^2, 
        3.10 < x <= 3.6}, {671.66 - 285.97 x + 30.25 x^2, 
        3.6 < x < 3.73}, {0, True}}]
    fT[x_] := 
     Piecewise[{{f[0], 
        0 <= x < .24}, {f[x - .24], .24 < x < 2}, {f[x + .24], 
        2 < x < 3.6 - .24}, {f[3.6], 
        3.6 - .24 < x < 3.6 + .24}, {f[x - .24], 3.6 + .24 < x < 5.1
        }, {0, True}}]
    Plot[{fT[x], f[x]}, {x, 0, 5.1}]

fig1

We will think about automation, but for now we will show the second case

g[x_] := Piecewise[{{6.83 - 12.66 x + 3.88 x^2, 
    0.68 < x < 0.82}, {51.06 - 79.00 x + 20.25 x^2, 
    1.2 < x < 3.08}, {48.51 - 76.88 x + 20.25 x^2, 
    0.82 < x < 1.2}, {594.35 - 270.81 x + 30.25 x^2, 
    3.85 < x < 5.1}, {0, True}}]
gT[x_] := 
 Piecewise[{{g[x + .24], 0 < x < 1.95062 - .24}, {g[x - .24], 
    1.95062 + .24 < x < 3.5}, {g[1.95062], 
    1.95062 - .24 < x < 1.95062 + .24}, {g[x + .24], 
    3.5 < x < 4.4762 - .24}, {g[4.4762], 
    4.4762 - .24 < x < 4.4762 + .24}, {g[x - .24], 
    4.4762 + .24 < x < 5.1}, {0, True}}]
Plot[{gT[x], g[x]}, {x, 0, 5.1}]

fig2

In the second example, we used data

In[26]:= FindMinimum[g[x], {x, 2}]

Out[26]= {-25.9894, {x -> 1.95062}}

In[28]:= FindMinimum[{g[x], 4 <= x <= 5}, {x, 4.5}]

Out[28]= {-11.7496, {x -> 4.4762}}
$\endgroup$
0

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.