Highlight parts of two different curves

In the plot generated by

    y = 1;
Plot[{Sin[x] x^-2/y, y}, {x, 0, 2}, PlotRange -> {0, 2}]


how can one highlight the curve as shown below, and possibly fill the region under the highlighted portion?

EDIT: A special request:

• Why do you define y=1 when you simplify everything by just using Plot[{Sin[x]/x^2,1},...]? Jun 8 at 23:27
• @DavidG.Stork presumably because y can take other values? Jun 9 at 11:05
• @infinitezero: But that is irrelevant to the problem... see? Jun 9 at 15:49
• Yes, actually y can take different values. Jun 9 at 16:48

Clear["Global*"]

y = 1;

Plot[Evaluate[Tooltip /@
{Sin[x] x^-2/y, y, Min[Sin[x] x^-2/y, y]}], {x, 0, 2},
PlotRange -> {0, 2},
PlotLegends -> Placed["Expressions", {.7, .8}],
PlotStyle -> {Automatic, Automatic, {Red, Thick}},
Filling -> 3 -> Bottom]


EDIT: Per request in comment

Plot[Evaluate[Tooltip /@ {
Max[Sin[x] x^-2/y, y], Min[Sin[x] x^-2/y, y]}],
{x, 0, 2}, PlotRange -> {0, 2},
PlotLegends -> Placed["Expressions", {.84, .35}],
Filling -> {1 -> Top, 2 -> Bottom}]


• Thank @Bob Hanlon. How can I fill the top right $\{(1,1), (1,2), (2,1), (2,2) \}$ and bottom left $\{(0,0), (0,1), (1,0), (1,1)\}$, sections? Jun 9 at 16:46
• Almost there! I need only to highlight the top right and bottom left squares. Jun 9 at 17:13
• Add a drawing to show what you want. Jun 9 at 17:15
• Thanks @Bob Hanlon. Just added a drawing. Jun 9 at 17:31
• Just use Epilog to add two Rectangles Jun 9 at 18:00

This does not make the line red where you want it to be, but it does highlight the region under the highlighted portion:

y = 1;
p = Plot[{Sin[x] x^-2/y, y}, {x, 0, 2}, PlotRange -> {0, 2}];
rp = RegionPlot[z < Sin[x] x^-2/y && z < 1, {x, 0, 2}, {z, 0, 2},
PlotStyle -> Red, BoundaryStyle -> Red];
Show[rp, p]



Edit: I could not plot the two functions together as I kept having color function issues. But I found the intersection of the two functions and defined a ColorFunction so that the functions change color after they intersect:

y = 1;
f1 = Sin[x] x^-2/y;
rp = RegionPlot[z < f1 && z < 1, {x, 0, 2}, {z, 0, 2},
BoundaryStyle -> None];

intersection = Values@First@FindRoot[f1 - y, {x, 1}];

f1Plot = Plot[f1, {x, 0, 2}, PlotRange -> {0, 2},
ColorFunction ->
Function[{x, z}, If[x < intersection/2, Opacity[0.5,Blue], Red]]];

yPlot = Plot[y, {x, 0, 2}, PlotRange -> {0, 2},
ColorFunction ->
Function[{x, z}, If[x < intersection/2, Red, Opacity[0.5,Orange]]]];
Show[f1Plot, yPlot, rp]



I have no idea why, but I had to use intersection/2 as x the value at which the colors change...it should just be intersection but clearly there's something I don't understand that is going on.

Yet another way:

 y = 1;

Plot[{Sin[x] x^-2/y, y}, {x, 0, 2},
PlotRange -> {0, 2},
PlotLabels -> "Expressions",
Filling ->
{1 -> {Bottom, LightRed}, 2 -> {Top, White}}]


• Solve the equation to find the median point x0 and split all the curve to two parts by ConditionalExpression.
Clear[x0];
y = 1;
x0 = x /.
Solve[Sin[x] x^-2/y == y, x,
Reals][[1]]; Plot[{ConditionalExpression[Sin[x] x^-2/y,
0 <= x <= x0], ConditionalExpression[Sin[x] x^-2/y, x0 <= x <= 2],
ConditionalExpression[y, 0 <= x <= x0],
ConditionalExpression[y, x0 <= x <= 2]}, {x, 0, 2},
PlotStyle -> {Automatic, Red, Red, None},
Filling -> {{3 -> {Bottom, Darker@Cyan}, {4 -> {Top, Darker@Cyan}}}},
AxesOrigin -> {0, 0}]


Just to illustrate dynamic anwer:

Manipulate[Module[{f, s},
f[x_, y_] := Sin[x] x^-2/y;
s = {x, f[x, p]} /. FindRoot[f[x, p] == p, {x, 1}];
Plot[{f[x, p], p, Min[f[x, p], p]}, {x, 0, 2}, PlotRange -> {0, 2},
PlotStyle -> {Black, Black, Red},
Epilog -> {LightBlue, Rectangle[{0, 0}, s], Rectangle[s, {2, 2}]}]],
{p, 0.5, 3}]
`