# Translation plot of some functions

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:

So far everything is ok.

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

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?

@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:

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!

• 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? Commented Aug 16, 2018 at 12:01
• 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.) Commented Aug 16, 2018 at 12:20

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]


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


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

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


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


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