Another weird plotting result

Question

I asked a question this morning here, which has been resolved.

However, I got another problem. I want to add some lines to the graph, which turns out glitched. The code is as follows,

g1 = Plot[Sin[x], {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[2/3] < Sin[x] < ArcSin[1]], 
   PlotStyle -> Orange, Filling -> Axis, AxesOrigin -> {0, 0}];
g2 = Plot[Sin[x], {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[1/3] < Sin[x] < ArcSin[2/3]], 
   PlotStyle -> Blue, Filling -> Axis, AxesOrigin -> {0, 0}];
g3 = Plot[Sin[x], {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[0] < Sin[x] < ArcSin[1/3]], 
   PlotStyle -> Orange, Filling -> Axis, AxesOrigin -> {0, 0}];
g4 = Plot[Sin[x], {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[-1/3] < Sin[x] < ArcSin[0]], 
   PlotStyle -> Blue, Filling -> Axis, AxesOrigin -> {0, 0}];
g5 = Plot[Sin[x], {x, -2*Pi, 2*Pi}, 
   RegionFunction -> 
    Function[x, ArcSin[-2/3] < Sin[x] < ArcSin[-1/3]], 
   PlotStyle -> Orange, Filling -> Axis, AxesOrigin -> {0, 0}];
g6 = Plot[Sin[x], {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[-1] < Sin[x] < ArcSin[-2/3]], 
   PlotStyle -> Blue, Filling -> Axis, AxesOrigin -> {0, 0}];
l1 = Plot[y = 1, {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[2/3] < Sin[x] < ArcSin[1]], 
   PlotStyle -> Red, AxesOrigin -> {0, 0}];
l2 = Plot[y = 2/3, {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[1/3] < Sin[x] < ArcSin[2/3]], 
   PlotStyle -> Red, AxesOrigin -> {0, 0}];
l3 = Plot[y = 1/3, {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[0] < Sin[x] < ArcSin[1/3]], 
   PlotStyle -> Red, AxesOrigin -> {0, 0}];
l4 = Plot[y = -1/3, {x, -2*Pi, 2*Pi}, 
   RegionFunction -> Function[x, ArcSin[-1/3] < Sin[x] < ArcSin[0]], 
   PlotStyle -> Red, AxesOrigin -> {0, 0}];
l5 = Plot[y = -2/3, {x, -2*Pi, 2*Pi}, 
   RegionFunction -> 
    Function[x, ArcSin[-2/3] < Sin[x] < ArcSin[-1/3]], 
   PlotStyle -> Red, AxesOrigin -> {0, 0}];
l6 = Plot[y = -3/3, {x, -2*Pi, 2*Pi}, 
   RegionFunction -> 
    Function[x, ArcSin[-3/3] < Sin[x] < ArcSin[-2/3]], 
   PlotStyle -> Red, AxesOrigin -> {0, 0}];
Show[{g1, g2, g3, g4, g5, g6, g7, l1, l2, l3, l4, l5, l6}, 
 PlotRange -> {{-2*Pi, 2*Pi}, {-1, 1}}, AxesOrigin -> {0, 0}]

The problems of this graph are marked by the black circles. It seems that the red lines are at the right position (y=1/3=0.6666...), but g2 and g5 is not precisely drawn. Take a closer look at the picture, g2 and g5 is plotted a bit longer than what they are supposed to be.

I want to solve this problem. Thank you in advance!

Answer 1

I would approach this differently. Managing so many graphs that are similar and need to be updated similarly might prove a headache. We can take advantage of the mathematical similarities with functionality that is built into Mathematica.

The sort of coloring you're after can be done with Mesh and MeshShading. The Ceiling function may be used to construct a step function.

Show[
 ParametricPlot[{x, t Sin[x]}, {x, -2 Pi, 2 Pi}, {t, 0, 1},
  MeshFunctions -> {Sin[#1] &}, Mesh -> {Range[-2, 2]/3}, 
  MeshShading -> {{Opacity[0.4], Blue}, {Opacity[0.4], Orange}}],
 Plot[Sin[x], {x, -2 Pi, 2 Pi},
  MeshFunctions -> {Sin[#1] &}, Mesh -> {Range[-2, 2]/3}, 
  MeshShading -> {Blue, Orange}],
 Plot[Sign[Sin[x]] Ceiling[Abs[Sin[x]], 1/3], {x, -2 Pi, 2 Pi},
  PlotStyle -> Red],
 AspectRatio -> 1/GoldenRatio, Frame -> False
 ]

Answer 2

Actually your graphics are correct, they ARE "precisely drawn", the problem does not come from Mathematica.

You just made a little (but repeated) mathematical mistake when defining the RegionFunction parts : you have to get rid of all the ArcSin and everything will be fine.

For example in the graphic g1, instead of :

ArcSin[-1/3] < Sin[x] < ArcSin[0]

you should just write

-1/3 < Sin[x] < 0

which is more coherent you'll agree ...

Do the same for all your other graphics.