How to find the Bottom

Question

While I was thinking about Plot with a reference line and shaded / colored region, I came up with

Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, 
Filling -> {5 -> {4}, 4 -> {3}, 3 -> {2}, 2 -> Bottom}]

as an easy solution strategy directly from the help instructions.

One can try with Table to virtually automate the Filling Stuff, but will fail miserably on n -> Bottom

Table[n -> {n - 1}, {n, 3, 5, 1}]

{3 -> {2}, 4 -> {3}, 5 -> {4}}

Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, 
Filling -> Table[n -> {n - 1}, {n, 3, 5, 1}]]

So, how to add n -> Bottom to a Table ?

Answer 1

When I decide to automate a special kind of plot, I try to produce something that can handle more than the particular special case I have at hand. For this question, I think the following makes a good start.

SetAttributes[myPlot, HoldAll]
myPlot[expr_, hlines : {__}, domain_, opts : OptionsPattern[]] :=
  Module[{n, fills, plt},
    n = Length[hlines] - 1;
    fills =
      Append[If[n == 0, {}, Table[i -> {i - 1}, {i, 3, n + 2}]], 2 -> Bottom];
    plt = Prepend[Sort[hlines], expr];
    Plot[Evaluate @ plt, domain,
      Evaluate @ FilterRules[{opts, Filling -> fills}, Options[Plot]]]]

Of course, it handles the example given in the question.

myPlot[x, {4, 6, 8, 10}, {x, 0, 10}]

Other tests

Only on horizontal line.

myPlot[x, {5}, {x, 0, 10}]

Horizontal lines not ordered.

myPlot[x, {10, 4, 8, 6}, {x, 0, 10}]

Can accept plot options.

myPlot[8 Abs[Sin[x]], {4, 8, 6}, {x, 0, 2 π}, PlotStyle -> {Red, Blue, Green, Black}]

Note

I say this is the just start of a full implementation because there are argument patterns that Plot handles that myPlot won't. For example, suppose you wanted to plot several expressions as well a list of horizontals. As coded above, myPlot handles that badly. It would not be all that hard to add support for multiple-expression plots, but my point is that adding support for multiple expressions is only one of many features that might need to be added to make myPlot really robot.

Answer 2

Plot[{i, 0, 4, 6, 8, 10}, {i, 0, 10}, Filling -> Table[n -> {n - 1}, {n, 3, 6, 1}]]

Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, 
 Filling -> 
  Flatten[{Table[n -> {n - 1}, {n, 3, 6, 1}], {2 -> Bottom}}]]

or

Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, 
 Filling -> Table[n -> {n - 1}, {n, 2, 6, 1}] /. {1} -> Bottom // 
  Evaluate]

Answer 3

Use Table as in your question but add 2-> Bottom to the list.

Join[Table[n -> {n - 1}, {n, 3, 5, 1}], {2 -> Bottom}]

(* {3 -> {2}, 4 -> {3}, 5 -> {4}, 2 -> Bottom} *)

Plot[{i, 4, 6, 8, 10}, {i, 0, 10}, 
 Filling -> Join[Table[n -> {n - 1}, {n, 3, 5, 1}], {2 -> Bottom}]]