3
$\begingroup$

I have a list of coefficients, i.e. coefficients = {{a1,a2},{b1,b2},...,{an,bn}}

From this, I generate a list of functions.

I then plot these functions with a specified plot range, and add plot legends which are labelled by the coefficients.

My question is: How do I only show plot legends for those functions which appear within the plot range?

My code so far:

coefficients = Table[{x, RandomReal[]}, {x, 0, 5}];
functions = #1 + Cos[#2 x] & @@@ coefficients;
Plot[Evaluate@functions, {x, -2 Pi, 2 Pi}, PlotRange -> {-2, 2}, PlotLegends -> ToString /@ coefficients]

In the resulting plot below we see more legends than curves.

The plot resulting from the code above. We see only some plots in the specified plot range, but plot legends displayed for all functions.

$\endgroup$
2
$\begingroup$

Edit by OP. Here is the full working code:

ClearAll["Global`*"];
coefficients = Table[{x, RandomReal[]}, {x, 0, 5}];
functions = #1 + Cos[#2 x] & @@@ coefficients;
p = Plot[Evaluate@functions, {x, -2 Pi, 2 Pi}, PlotRange -> {-2, 2}, PlotLegends -> ToString /@ coefficients];

memberQ = MemberQ[p[[1]], #, Infinity] & /@ p[[2, 1, 1]];
positions = Position[memberQ, False];
p[[2, 1, 1]] = Delete[p[[2, 1, 1]], positions];
p

p[[2,1,1]] returns the list of graphics elements which correspond to the coloured curves. MemberQ is used to test p[[1]] (which is the displayed plot) as to which coloured curves are displayed. It returns a list of True and False values. I then use Position to return the positions in p[[2,1,1]] of the curves that are not displayed. Then I update p[[2,1,1]] and finally re-display p. Here is the result

Result of the code block above

Original post that solved most of the problem

I do not know how to do it properly but you can check if a color exists by doing

coefficients = Table[{x, RandomReal[]}, {x, 0, 5}];
functions = #1 + Cos[#2 x] & @@@ coefficients;
p = Plot[Evaluate@functions, {x, -2 Pi, 2 Pi}, PlotRange -> {-2, 2}, PlotLegends -> ToString /@ coefficients]

MemberQ[p[[1]], yourColor, Infinity]

you find the colours in the legend by checking p[[2,1,1,i,2]] for all valid i. If the check returns False you can Delete the entry from the legend. You could use DeleteCases for that but i cannot get that to work right now for lack of time. In spirit it should look like:

p[[2,1,1]] = DeleteCases[p[[2,1,1]], MemberQ[p[[1]], #[[2,2]], Infinity]&]

but where there is a pattern instead of a test.

$\endgroup$
4
$\begingroup$

An analytical solution would check if the functions were in range of the y-plot range over the domain of the x-plot range. You may use region functions like ImplicitRegion, RegionIntersection, and RegionMeasure to achieve this.

ClearAll[x, y];
emptyIntersection[foos_, domain_, range_] :=
 Position[
  Map[RegionMeasure[#, 1] &,
   RegionIntersection[
      ImplicitRegion[FunctionRange[{#, Between[domain]@x}, x, y], y],
      ImplicitRegion[Between[range]@y, {y}]
      ] & /@ foos],
  0]

emptyIntersection performs such a check when given a list of equations and the domain and range of the plot and returns the positions of the functions that are not in the range.

With functions as in OP then

emptyIntersection[functions, {-2 \[Pi], 2 \[Pi]}, {2, 4}]
{{1}, {2}, {6}}

The LegendLayout option of LineLegend can be used to Delete the legend of functions not in range.

Plot[functions, {x, -2 Pi, 2 Pi}, PlotRange -> {2, 4},
 PlotLegends ->
  LineLegend[Automatic, ToString /@ coefficients,
   LegendLayout -> (Grid[
       Delete[#, emptyIntersection[functions, {-2 \[Pi], 2 \[Pi]}, {2, 4}]]] &)
   ]
 ]

Mathematica graphics

It also works well with Manipulate.

Manipulate[
 Plot[functions, {x, -2 Pi, 2 Pi}, PlotRange -> plotrange,
  PlotLegends ->
   LineLegend[Automatic, ToString /@ coefficients,
    LegendLayout -> (Grid[
        Delete[#, 
         emptyIntersection[{-2 \[Pi], 2 \[Pi]}, plotrange]]] &)
    ]
  ],
 {{plotrange, {-1, 0}}, 
  IntervalSlider[#, {-1, 6, .1}, MinIntervalSize -> 1, 
    Method -> "Push"] &}
 ]

enter image description here

Hope this helps.

$\endgroup$
  • $\begingroup$ Nice. My suggestions would be to wrap emptyIntersection in a Module (or something similar) to make it easily reusable with other variables (aside from x and y), i.e. emptyIntersection[foos_, domain_, range_, x_] := Module[{y}, YOUR CODE] $\endgroup$ – Tom Feb 25 at 10:30
  • 1
    $\begingroup$ @Tom Yeah, I was using formal symbols but FunctionRange was joy cooperating with them. Which reminds me that I need to post that to WRI Support. $\endgroup$ – Edmund Feb 25 at 11:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.