How to dynamically toggle curves on/off in a crowded Plot?

Question

When multiple curves appear in a single plot, it is useful to interactively turn certain curves on or off to visually compare smaller numbers of curves. It is trivial to put a quick dynamic together, as in this toy example

funcs = {Sin[x], Cos[x], Tanh[x]}; 
checked = ltexts = {"sin", "cos", "tanh"}; 
Column[{TogglerBar[Dynamic[checked], ltexts], 
   Dynamic[Block[{sel}, 
     sel = Sort[checked /. Thread[ltexts -> Range[Length[ltexts]]]]; 
      Plot[funcs[[sel]], {x, 0, 3*Pi}, PlotLegends -> ltexts[[sel]]]]]}]

This approach, is a one-off solution. I am looking for a more elegant solution that can be applied to any plot, with a user interface that is a natural to the problem. The buttonbar above the plot is not a natural interface. Clicking on the curve or legend would be a natural action to toggle a curve's visibility.

I intend to answer my own question, which I humbly propose as a reusable solution, but I would like to ask the community for improvements or enhancements.

Answer 1

This solution uses the new PlotLegends feature of version 9.

A natural user interaction with a plot would be to click on a curve to toggle it off, but this does not work well to toggle a curve back on, and I could not figure out how to do that anyway. Second best is to use the legend to toggle the curve visibility. The function DynamicLegend is a wrapper around any plot function, as in

DynamicLegend[Plot[{Sin[x], Cos[x], Tanh[x]}, {x, 0, 3*Pi}, 
PlotStyle -> Thick, PlotLegends -> LineLegend[{"sin", "cos", "tanh"}], 
Frame -> True]]

which yields the output below, after the user has turned off the visibility of the $\cos(x)$ curve by clicking on the legend text.

The structure of a plot with legends is

Legended[Graphics[...],{Placed[LineLegend[{directives}, {legend_text}, ...]...]

The idea of the solution is to first evaluate the plot for the sole purpose of capturing the directives and legend_text, adding transparency switches to the directives, turning the legend_text into Togglers, then replotting with the new dynamic directives and legend_text.

(* Don't allow the Plot to evaluate yet *)
Attributes[DynamicLegend] = {HoldAll}; 

DynamicLegend[(plotfnc_)[f_, args___, (opts___)?OptionQ]] := 
Module[{plot},
(* evaluate the plot *) 
plot = plotfnc @@ {f, args, opts}; 
(* if it does not have a legend, there is nothing to do *)
If[ !MatchQ[plot, _Legended], Return[plot]];

DynamicModule[{
(* get the directives and legend_text from the plot *)
leg = plot[[2,1]],
(* by default, all plots are visible (not transparent) *) 
trans = Table[False, {Length[plot[[2,1,1,1]]]}]
}, 
Dynamic[
(* dynamically re-evaluate the plot with dynamic PlotStyles and PlotLegends *)
plotfnc @@ {f, args,
(* prepend the directives with Transparent on dynamic switches *)
PlotStyle -> 
     Table[With[{i = i}, Flatten[Directive[If[TrueQ[trans[[i]]], 
          Transparent, Directive[]], leg[[1,1,i]]], 1, Directive]], 
      {i, Length[leg[[1,1]]]}],
(* turn the legend_text's into Togglers and shove them back into the *)
(* LineLegend structure.  Also, delete the old directives in the     *)
(* LineLegend structure to force PlotLegends to pick up the new      *)
(* directives, so legend lines turn on/off with the curves           *)
PlotLegends -> ReplacePart[leg, 
      Join[{{1, 1} -> Sequence[]}, Table[With[{i = i}, {1, 2, i} -> 
          Toggler[Dynamic[trans[[i]]], {True -> leg[[1,2,i]], 
            False -> leg[[1,2,i]]}, FrameMargins -> 0]], 
        {i, Length[leg[[1,2]]]}]]], FilterRules[{opts}, 
     Except[{PlotStyle, PlotLegends}]]}, 
(* only need dynamic updates when trans is modified  *)          
TrackedSymbols :> {trans}]]]

This solution has a known issue with PlotLegends->Automatic; the Toggler function intercepts the mouse click so the placeholder is not editable.

Answer 2

The following tries to let the user use whatever PlotStyle and any other Plot options they desire. It assumes Plot yields a list of directives and lines for each function plotted, in the order given in the arguments.

I seemed to run into obstacles with standard controls, so I wrote my own plus a helper function.

• getPlotStyles returns the directives for the plot of each function. These are needed to make the label (used as a legend).
• clickToggler switches between two expressions per mouse click. Perhaps Toggler could be used, but it didn't work for me.
• makeLabel puts together a clickable legend that turns graphs on/off. It is a grid of clickTogglers.

Preliminary definitions:

getPlotStyles[nFuncs_, funcs_, dom_, opts___] := 
  With[{style = PlotStyle /. FilterRules[{opts}, PlotStyle]}, 
   Thread[{Table[ColorData[1][i], {i, nFuncs}], 
     If[style =!= PlotStyle, If[Head[style] === List,
       style, ConstantArray[style, nFuncs]], ConstantArray[{}, nFuncs]]}]];

clickToggler[Dynamic[x_], e_, opts : OptionsPattern[]] := clickToggler[Dynamic[x], e, e, opts];
clickToggler[Dynamic[x_], on_, off_, opts : OptionsPattern[]] := 
  EventHandler[Dynamic[If[x, on, off]], {"MouseClicked" :> (x = ! x)}, opts];

makeLabel[Dynamic[display_], styles_, funcs_] := 
  With[{background = {Opacity[0], Rectangle[{-2, -1}, {2, 1}]}, 
    circleslash = {Thickness[Medium], Dashing[{}], Opacity[1], Red, Circle[], 
      Line[{{-1, -1}, {1, 1}}/Sqrt[2]]}},
   Grid[Table[With[{i = i}, (* { sample styled line, label } *)
      {Graphics[{Append[styles[[i]], {Line[{{-2, 0}, {2, 0}}], 
           clickToggler[Dynamic[display[[i]]], background, {background, circleslash}]}]},
        ImageSize -> {24, 12}, AspectRatio -> 1/2], 
       clickToggler[Dynamic[display[[i]]], 
        Panel[TraditionalForm[funcs[[i]]], Background -> White, FrameMargins -> 1]]}
     ], {i, Length@funcs}], BaseStyle -> "Label", Alignment -> {Center, Center}]];

myPlot plots the graph and has the following features:

• It is called just like Plot and all its arguments are passed to Plot, so hopefully most of Plots features still work.

• It takes each graph and wraps it in a clickToggler (defined above) that turns the graph off if it is clicked.

• If whitespace in the plot is clicked, a menu pops up that toggles the graphs on/off. Click away from it to make it disappear.

• It uses Labeled to add an interactive legend for turning graphs on/off. Ideally either the PlotLegend option would be intercepted and replaced with this, or myPlot would have this as its own option.

The code allows for the list of functions to be wrapped by Tooltip etc. The first two definitions are the way in. The third is called by the first two. The fourth at the very end lets a single function not in a List be plotted like normal, no legend, no clicking on/off.

SetAttributes[myPlot, HoldAll];
myPlot[wrapper_[funcs_List], rest___] := With[{n = Length[funcs]}, myPlot[n, funcs, wrapper@funcs, rest]];
myPlot[funcs_List, rest___] := With[{n = Length[funcs]}, myPlot[n, funcs, funcs, rest]];
myPlot[nFuncs_Integer, funcs_, plotargs___] := 
  DynamicModule[{
        display = ConstantArray[True, nFuncs], (* array of T/F indicating a graph is on/off *)
           plot, (* the base Plot *)
            pos, (* the positions of the group of lines making up each graph *)
         curves, (* the graphics commands making up each graph *)
         styles, (* the styles of each graph *)
      popupmenu},(* variable that toggles between the popup menu and nothing *)
    popupmenu = {}; (* popupmenu starts off blank *)
    plot = Show[Plot[plotargs], Graphics[Dynamic@popupmenu]];
    pos = DeleteDuplicates[Most /@ Position[plot, _Line, \[Infinity]]];
    curves = Extract[plot, pos];
    styles = getPlotStyles[nFuncs, plotargs];
    Labeled[
     EventHandler[Dynamic@ReplacePart[plot,
         Table[With[{i = i}, 
          pos[[i]] -> clickToggler[Dynamic[display[[i]]], curves[[i]], Line[{}], PassEventsUp -> False]],
          {i, nFuncs}]],
      {"MouseClicked" :> (popupmenu = 
          If[popupmenu === {},
            Inset[Framed[makeLabel[Dynamic[display], styles, funcs], 
             Background -> White, FrameStyle -> Thin], MousePosition["Graphics"]],
            {}])}
      ],
     makeLabel[Dynamic[display], styles, funcs],
     Right],
    SaveDefinitions -> True];
myPlot[X___] := Plot[X]; (* default to Plot *)

Example

myPlot[Tooltip@{Sin[x], Tan[2 x], Cos[x]}, {x, 0, 2 π}, PlotRange -> 2, 
 PlotStyle -> {Thick, Opacity[0.5], Directive[Brown, Thick, Dashed]}]

Showing the popup menu:

There are many cases to test, but I only tried a few.

Answer 3

 funcs = {Sin[x], Cos[x], Tanh[x]};
 checked = ltexts = {"sin", "cos", "tanh"}; (* thanks: Ajasja *)

Alternative approaches:

UsingTogglerBar as PlotLabel and toggling its visibility based on CurrentValue["MouseOver"]:

 Dynamic[Framed@Plot[
 funcs[[Sort[checked /. Thread[ltexts -> Range[Length[ltexts]]]]]],
 {x, 0, 3*Pi}, PlotStyle -> Thick,  Evaluated -> True,
 PlotLegends -> "Expressions",
 PlotLabel -> (If[CurrentValue["MouseOver"],
    #, Invisible@#] &[
  TogglerBar[Dynamic[checked], ltexts, Appearance -> "Button"]])]]

Or, Overlaying Plot and TooglerBar, toggling visibility of the latter based on CurrentValue["MouseOver"]:

 Dynamic@Overlay[{If[CurrentValue["MouseOver"],
 TogglerBar[Dynamic[checked], ltexts, Appearance -> "Button"], ""],
 Dynamic[ Plot[funcs[[Sort[ checked /. Thread[ltexts -> Range[Length[ltexts]]]]]], 
 {x, 0, 3*Pi},  PlotStyle -> Thick,
 Evaluated -> True,
 ImagePadding -> {{Automatic, Automatic}, {Automatic, 40}},
 PlotLegends -> "Expressions"]]},
  All, 1, Alignment -> {Center, Top}]

Answer 4

FYI, you can use TogglerBar and other controls in Manipulate:

funcs = {Sin[x], Cos[x], Tanh[x]};
Manipulate[
 Plot[fs, {x, 0, 3 Pi}],
 {fs, funcs, ControlType -> TogglerBar}]

Appearance -> "Vertical", ControlPlacement -> Left:

Answer 5

I was inspired by the other answers to keep working on this, and I came up with a different method that, combined with some techniques from the other answers, does everything I was originally looking for (although not fully specified in the question).

The new solution is based on using Annotation to tag each curve and legend text with the position of the curve within the list of curves, and using MouseAnnotation[] to identify which curve to switch on or off when the mouse is clicked. Either the curve or legend text can be clicked to change the state of the curve.

Set $PlotTogglerOpacity=0 to make the curves disappear completely, in which case click the legend text to bring it back.

As a convenience for the way I intend to use the function, I also apply the legend text as Tooltip on the curves. This is optional and not necessary for the function to work, so you can remove that code if you don't like that behavior.

Attributes[PlotToggler] = {HoldFirst};
(* a global variable for setting the opacity of dimmed curves *)
$PlotTogglerOpacity = 0.2;
PlotToggler[plotfnc_[f_, args___, opts___?OptionQ]] :=
DynamicModule[{plot, legend, ldir, ltext, annof, annopl, fropts, dim},
(* evaluate the plot, ensuring the presence of legends *)
plot = plotfnc @@ {f, args, opts, PlotLegends -> Automatic};
(* pull the legend apart, getting the graphics directives and legend text *) 
legend = plot[[2, 1]];
ldir = legend[[1, 1]];
ltext = legend[[1, 2]];
(* annotate the curves with tooltips and mouse annotations *)
(* tooltips are optional but convenient, delete tooltip code if you wish *)
(* mouse annotations are the indicies of each curve *)
annof = Table[
Tooltip[Annotation[f[[i]], i, "Mouse"], ltext[[i]]], {i, 
 Max[Length[f], Length[ltext]]}];
(* shove mouse annotated legend text back into the legend *)
annopl = 
ReplacePart[legend, 
Join[{{1, 1} -> Sequence[]}, 
 Table[{1, 2, i} -> Annotation[ltext[[i]], i, "Mouse"], {i, 
   Length[ltext]}]]];
(* we will be hijacking PlotStyle and PlotLegends later *)
fropts = FilterRules[Flatten[{opts}], 
Except[{PlotStyle, PlotLegends}]];
(* by default, all curves are not dimmed *)
dim = Table[False, {Length[ldir]}];
EventHandler[
Dynamic[
plotfnc @@ {annof, args,
(* append a switchable low opacity to the graphics directives *)
(* found earlier *)
PlotStyle -> 
   Table[With[{i = i}, 
     Flatten[Directive[ldir[[i]], 
       If[TrueQ[dim[[i]]], Opacity[$PlotTogglerOpacity], 
        Directive[]]], 1, Directive]], {i, Length[ldir]}],
  PlotLegends -> annopl,
  fropts}, TrackedSymbols :> {dim}
],
(* when the mouse is clicked, use the mouse annotation to *)
(* identify the curve to dim *)
{"MouseClicked" :> (If[
   MatchQ[MouseAnnotation[], _Integer], 
   dim[[MouseAnnotation[]]] = ! dim[[MouseAnnotation[]]]])}
]
]

Known issues:

• The color sample in the legend is not clickable.
• Template legend text generated by PlotLegends->Automatic cannot be changed after the fact.
• Annotations do not work with ListPlot. Wolfram tech support has already been informed. Use LineListPlot instead. ListLogLinearPlot and related functions support Annotations.

Usage:

PlotToggler@
 Plot[{Sin[x], Cos[x], Tanh[x]}, {x, 0, 3 Pi}, PlotStyle -> Thick,
  PlotLegends -> LineLegend["Expressions"], Frame -> True]

Answer 6

In a similar vein as a previous answer this changes the color without the need to redraw the plot.

I don't have v9 so I used buttons instead of legends, it is probably easy to adapt this to PlotLegends

The idea is to first plot the functions with unique colors, in the resulting Graphics those colors are replaced with Dynamic-wrapped Opacity[1,color] and the buttons switch the 0 to 1 and 1 to 0.

Attributes[togglePlot] = {HoldAll};
togglePlot[funcs_, range_] := Module[
  {initcolors, p},
  (* Some unique colors *)
  initcolors = Hue /@ Range[1/Length[funcs], 1, 1/Length[funcs]];
  p = Plot[funcs, range, PlotStyle -> initcolors];

  DynamicModule[{
    (* Actual colors used *)
    colors = Opacity[1, ColorData[1][#]] & /@ Range[Length[funcs]],
    q},
   Column@{
     p /.Table[With[{i = i}, 
        initcolors[[i]] -> Dynamic[colors[[i]]]], {i, 1, Length[funcs]}],
     ButtonBar[MapIndexed[(#1 :> Function[{},
           colors[[First@#2, 1]] = colors[[First@#2, 1]] /. {0 -> 1, 1 -> 0}]) &, funcs]]}
   ]]

togglePlot[{Sin[x], Cos[x], Tan[x]}, {x, -Pi, Pi}]

Answer 7

This is just a small addendum to show that one can use the whole plot to switch between the individual functions. By clicking anywhere in the figure, it toggles through the curves one-by-one, and then shows all of them again.

This has some drawbacks (like the necessity to specify an absolute PlotRange, assign styles to individual curves to keep coloring consistent, and wrapping singleton legends in lists) but these are usually there if one devotes so much time for visualization that even invents a new interface...

funcs = {Sin[x], Cos[x], Tanh[x]};
style = Thread[funcs -> {{Thick, Blue}, {Thick, Red}, {Thick, Green}}];    
switch = 0;

EventHandler[
 Dynamic[Plot[
   Evaluate@Part[funcs, switch /. (0 -> All)], {x, 0, 3 Pi},
   PlotStyle -> (Part[funcs, switch /. (0 -> All)] /. style),
   PlotRange -> {{0, 3 Pi}, {-1, 1}},
   PlotRangePadding -> .1,
   PlotLegends -> Flatten@{Part[funcs, switch /. (0 -> All)]}
   ], TrackedSymbols :> {switch}],
 {"MouseClicked" :> If[switch == Length@funcs, switch = 0, switch++]}]