3
$\begingroup$

I found an elegant solution to my problem on this site in the answer No 2 to the post Filling a curve to a vertical axis. Consider the following example:

lst = Table[{1.3 - Sin[\[Pi] t], 1.4 - Cos[\[Pi] t]}, {t, 0, 1, 0.05}];

lst2 = Table[{1.5 - 0.8 Sin[\[Pi] t], 1.9 - 0.3 Cos[\[Pi] t]}, {t, 0, 
    1, 0.05}];

plt = ListLinePlot[{lst, lst2}, Joined -> True, 
  PlotMarkers -> Automatic
  , AxesOrigin -> {0, 0}]

It yields enter image description here

Applying to this plot function

fillVertical[plot_, x0_ : 0.] := 
  plot /. Line[
     p_] :> {{Opacity[0.2], 
      Polygon[p~Join~{{N@x0, p[[-1, 2]]}, {N@x0, p[[1, 2]]}}]}, 
     Line[p]};

as proposed in Filling a curve to a vertical axis gives almost what I need:

fillVertical[plt, 0.1]

enter image description here

To become even more happy, I would like to have an option. e.g., to switch off vertical filling for second, third, e.t.c. curves, i.e., for lst2 in the example above. Second desired option is to extend filing to the bottom and to the top of the picture. My knowledge of Wolfram Language is insufficient to find how I could do that.

Update

Please note that I need a solution which would preserve style of plot markers and correct plot legends.

Improve this question
$\endgroup$

3 Answers 3

Reset to default
6
$\begingroup$ 
ClearAll[addHorizontalFilling]

addHorizontalFilling[pos_ : All, pr_ : Automatic] := 
  Module[{xyr = pr /. Automatic -> 
      Transpose @ Charting`get2DPlotRange[If[Head @ # === Legended, First@#, #]],
    xyrnp = pr /. Automatic -> 
      Transpose @ PlotRange[If[Head @ # === Legended, First @ #, #]]},
    xyr = {Clip[#, First @ xyrnp], #2} & @@ xyr;
    ReplaceAt[#, l_Line :>
      Module[{cl = Transpose[{Clip[#, First @ Transpose @ xyr], 
             Clip[#2, Last @ Transpose @ xyr]} & @@ Transpose[l[[1]]]]}, 
       {l, Opacity[.2], 
        Polygon[Join[{xyr[[1]], {cl[[1, 1]], xyr[[1, 2]]}}, cl, 
         {{0, xyr[[2, 2]]} + {cl[[-1, 1]], 0}, {xyr[[1, 1]], xyr[[2, 2]]}}]]}], 
      Position[#, _Line][[pos]]]] &;

Examples:

llp = ListLinePlot[{lst, lst2}, Joined -> True, 
   PlotMarkers -> Automatic, AxesOrigin -> {0, 0}, 
   PlotLegends -> {"list 1", "list 2"}];

Add horizontal filling to all curves (default):

addHorizontalFilling[] @ llp

enter image description here

Add filling to the first curve only:

addHorizontalFilling[1] @ llp

enter image description here

Add filling to the second curve only:

addHorizontalFilling[2] @ llp

enter image description here

Use the second argument to specify the rectangle coordinates to be filled:

addHorizontalFilling[All, {{.1, .5}, {1.2, 2.2}}] @ llp

enter image description here

Add filling to curves 1 and 3:

pltb = addHorizontalFilling[{1, 3}] @
 ListLinePlot[{lst, lst2, Threaded[{-.1, 1}] + lst}, 
  Joined -> True, 
  PlotMarkers -> Automatic, 
  AxesOrigin -> {0, 0}, 
  PlotLegends -> {"list 1", "list 2", "list 3"}, 
  PlotRange -> {{0, All}, {0, All}}]

enter image description here

hatchFillings = HatchFilling[#, 2, 10] & /@ {Pi/4, -Pi/4, Pi};

ReplaceAll[{l_Line, a___, p_Polygon} :>
   {l, a, p, Opacity[1],
    Last[hatchFillings = RotateLeft[hatchFillings]], p}] @ pltb

enter image description here

Improve this answer
$\endgroup$
6
  • $\begingroup$ Solution of @kglr is excellent from all points of view. Unfortunately, it assumes that option PlotRangeClipping is set to False which is not my case. Therefore, currently I am using a hybrid of solutions proposed by @kglr and @DanielHuber. Is there a method to put some text outside PlotRange without setting PlotRangeClipping to False? Or to impose some window for filling? $\endgroup$
    – Igor Kotelnikov
    Commented Jul 20, 2023 at 1:27
  • $\begingroup$ @IgorKotelnikov, please see the updated version $\endgroup$
    – kglr
    Commented Jul 20, 2023 at 14:08
  • $\begingroup$ I accepted your answer. Thank you so much. Nevertheless, at the moment I am using my own solution which is less difficult to understand. I'll post my answer soon. $\endgroup$
    – Igor Kotelnikov
    Commented Jul 23, 2023 at 14:00
  • 1
    $\begingroup$ It seems that this method fails in Mathematica 13.2 for plots without PlotLegeds, get2DPlotRange[If[Head @ # == Legended, First@#, #]] does not work as expected. $\endgroup$
    – Igor Kotelnikov
    Commented Jul 28, 2023 at 11:16
  • $\begingroup$ @IgorKotelnikov, thank you for the catch. I fixed the problem (Head @ # == Legended should be Head @ # === Legended ) $\endgroup$
    – kglr
    Commented Jul 28, 2023 at 12:48
3
$\begingroup$

To apply filling only to the first curve, you make a plot of the first curve with filling and a second plot withoutfilling of the rest of the curves and show them together:

lst1 = Table[{1.3 - Sin[\[Pi] t], 1.4 - Cos[\[Pi] t]}, {t, 0, 1, 
    0.05}];
lst2 = Table[{1.5 - 0.8 Sin[\[Pi] t], 1.9 - 0.3 Cos[\[Pi] t]}, {t, 0, 
    1, 0.05}];

pl1 = ListLinePlot[{lst1}, Joined -> True, PlotMarkers -> Automatic, 
   AxesOrigin -> {0, 0}];
pl2 = ListLinePlot[{lst2}, Joined -> True, PlotMarkers -> Automatic, 
   AxesOrigin -> {0, 0}];

fillVertical[plot_, x0_ : 0.] := 
  plot /. Line[
     p_] :> {{Opacity[0.2], 
      Polygon[p~Join~{{N@x0, p[[-1, 2]]}, {N@x0, p[[1, 2]]}}]}, 
     Line[p]};

Show[fillVertical[pl1, 0.1], pl2]

enter image description here

To make filling to the bottom and top, you must split the data so that the function is unique. Then you plot the lower part with filling to the bottom and the upper part with filling to the top:

lst11 = Table[{1.3 - Sin[\[Pi] t], 1.4 - Cos[\[Pi] t]}, {t, 0, 1/2, 
    0.05}];
lst12 = Table[{1.3 - Sin[\[Pi] t], 1.4 - Cos[\[Pi] t]}, {t, 1/2, 1, 
    0.05}];
pl11 = ListLinePlot[{lst11}, Joined -> True, PlotMarkers -> Automatic,
    AxesOrigin -> {0, 0}, Filling -> Bottom];
pl12 = ListLinePlot[{lst12}, Joined -> True, PlotMarkers -> Automatic,
    AxesOrigin -> {0, 0}, Filling -> Top];
Show[{pl11, pl12}, PlotRange -> All]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ This is not what i want. I have used separate filling for upper and lower branches in the past. I want a better solution which would keep style of markers and correct plot legends. I'll update my question. $\endgroup$
    – Igor Kotelnikov
    Commented Jul 18, 2023 at 13:30
0
$\begingroup$

I accepted solution by @kglr although still use my own version:

fillVertical6[plt_, pos_ : All] := Module[{x0, x1, y0, y1}
  ,
  {{x0, x1}, {y0, y1}} = 
   Charting`get2DPlotRange[
    If[Head@# == Legended, First@#, #] &[plt]];
  (*Print[];*)
  ReplaceAt[#, l_Line :> {l, Opacity[.25]
       , Polygon[Join[
         {{x0, y0},
            {x1, y0}, {x1, #[[2]]}} &@( l[[1, 1]])
         , {{x1, #[[2]]}} &@( l[[1, 1]])
         , l[[1]]
         , {#, {x1, #[[2]]}, {x1, y1}, {x0, y1}} &@(l[[1, -1]])]]}, 
     Position[#, _Line][[pos]]] &[plt]
  ]


lst = Table[{1.3 - Sin[\[Pi] t], 1.4 - Cos[\[Pi] t]}, {t, 0, 1, 0.05}];
lst2 = Table[{1.5 - 0.8 Sin[\[Pi] t], 1.9 - 0.3 Cos[\[Pi] t]}, {t, 0, 
    0.7, 0.05}];

plt = ListLinePlot[{lst, lst2, Threaded[{-.1, 1}] + lst}, 
  Joined -> True, PlotMarkers -> Automatic, PlotLegends -> Automatic
  , PlotRange -> {{0.1, Full}, {0, Full}}
  , Prolog -> {Text[Style["lbl", Blue, 16], 
     Scaled[{0.5, 1.04}], {0, 1}]}
  , PlotRangeClipping -> False]

fillVertical6[plt, {1, 3}]

enter image description here

This is a bit different from @kglt's solution:

ClearAll[addHorizontalFilling]
addHorizontalFilling[pos_ : All, pr_ : Automatic] := 
  Module[{xyr = 
      pr /. Automatic -> 
        Transpose@
         Charting`get2DPlotRange[If[Head@# == Legended, First@#, #]], 
     xyrnp = pr /. 
       Automatic -> 
        Transpose@PlotRange[If[Head@# == Legended, First@#, #]]}, 
    xyr = {Clip[#, First@xyrnp], #2} & @@ xyr;
    ReplaceAt[#, 
     l_Line :> 
      Module[{cl = 
         Transpose[{Clip[#, First@Transpose@xyr], 
             Clip[#2, Last@Transpose@xyr]} & @@ 
           Transpose[l[[1]]]]}, {l, Opacity[.2], 
        Polygon[Join[{xyr[[1]], {cl[[1, 1]], xyr[[1, 2]]}}, 
          cl, {{0, xyr[[2, 2]]} + {cl[[-1, 1]], 0}, {xyr[[1, 1]], 
            xyr[[2, 2]]}}]]}], Position[#, _Line][[pos]]]] &;

addHorizontalFilling[{1, 3}]@plt

enter image description here

Improve this answer
$\endgroup$

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.