7
$\begingroup$

Example data:

data = <|"France" -> <|"10" -> 100.0, "11" -> 100.5, "12" -> 101.0, 
     "13" -> 101.5, "14" -> 102.3, "15" -> 102.8, "16" -> 103.1`, 
     "17" -> 103.3, "18" -> 103.7, "19" -> 103.9, "20" -> 104.1, 
     "21" -> 104.6, "22" -> 105.0|>, 
   "Spain" -> <|"10" -> 100.0, "11" -> 100.4, "12" -> 100.7, 
     "13" -> 100.5, "14" -> 100.1, "15" -> 99.9, "16" -> 99.9, 
     "17" -> 100.1, "18" -> 100.4, "19" -> 101.0, "20" -> 101.8, 
     "21" -> 102.0, "22" -> 102.0|>, 
   "Mean" -> <|"10" -> 100.0, "11" -> 100.2, "12" -> 100.3, 
     "13" -> 100.2, "14" -> 100.4, "15" -> 100.2, "16" -> 100.0, 
     "17" -> 100.0, "18" -> 100.0, "19" -> 99.9, "20" -> 100.1, 
     "21" -> 100.0, "22" -> 99.7|>, 
   "Italy" -> <|"10" -> 100.0, "11" -> 100.3, "12" -> 100.3, 
     "13" -> 100.8, "14" -> 102.7, "15" -> 102.7, "16" -> 102.5, 
     "17" -> 102.4, "18" -> 102.2, "19" -> 101.1, "20" -> 100.8, 
     "21" -> 100.1, "22" -> 99.7|>, 
   "Portugal" -> <|"10" -> 100.0, "11" -> 100.0, "12" -> 99.7, 
     "13" -> 99.2, "14" -> 98.6, "15" -> 98.1, "16" -> 97.8, 
     "17" -> 97.5, "18" -> 97.3, "19" -> 97.2, "20" -> 97.4, 
     "21" -> 97.4, "22" -> 97.9|>, 
   "Greece" -> <|"10" -> 100.0, "11" -> 100.0, "12" -> 99.7, 
     "13" -> 99.0, "14" -> 98.3, "15" -> 97.7, "16" -> 97.0, 
     "17" -> 96.8, "18" -> 96.6, "19" -> 96.5, "20" -> 96.4, 
     "21" -> 96.0, "22" -> 94.1|>|>;

My question is a follow-up on this answer by @kglr:

Highlight line in plot

Borrowing from it with some changes:

ClickPlot[dt_] :=
 
 DynamicModule[{black, check, color, lands, length, pal, pos, years},
  
  lands = Keys @ dt;
  years = ToExpression @ Keys[dt[[1]]];
  length = Length @ lands;
  
  pal = Flatten[{#, #}] &[ColorData[97, "ColorList"]];
  color = Table[i -> {pal[[i]], Thickness[0.0025]}, {i, length}];
  black = Table[i -> {Black, Thin}, {i, length}];
  check = Table[i -> Pane[Style[lands[[i]], "Panel"]], {i, length}];
  
  Dynamic @ Column[{
     ListPlot[dt,
      DataRange -> MinMax[years],
      Frame -> True,
      FrameTicks -> {{All, None}, {years, None}},
      GridLines -> {years, Automatic},
      ImageSize -> 600,
      Joined -> True,
      LabelingFunction -> None,
      PlotHighlighting -> "Ball",
      PlotLabels -> Automatic,
      PlotStyle -> Values[<|black, KeyTake[pos] @ color|>]
      ],
     
     Panel @ CheckboxBar[
       Dynamic[pos], check,
       Method -> "Active",
       Appearance -> "Horizontal" -> {Automatic, 7}
       ]
     }]
  ]

Highlight France, Spain and Italy:

ClickPlot[data]

enter image description here

I would like to omit the CheckboxBar and click the PlotLabels instead. This should be extremely difficult to achieve. But maybe it would be possible to link the plot lines to Button - wrappers. (See documentation for ListPlot, Details and Options).

Then, by clicking one or more lines (possibly at the right end points), one would get the highlight effects as shown above.

$\endgroup$
1

2 Answers 2

10
$\begingroup$

You can replace the PlotLabels with Buttons:

ClickPlot[dt_] := 
 DynamicModule[{black, check, color, lands, length, pal, pos = {}, 
   years}, lands = Keys@dt;
  years = ToExpression@Keys[dt[[1]]];
  length = Length@lands;
  pal = Flatten[{#, #}] &[ColorData[97, "ColorList"]];
  color = Table[i -> {pal[[i]], Thickness[0.0025]}, {i, length}];
  black = Table[i -> {Black, Thin}, {i, length}];
  Dynamic@ListPlot[
    dt,
    DataRange -> MinMax[years],
    Frame -> True, FrameTicks -> {{All, None}, {years, None}},
    GridLines -> {years, Automatic},
    ImageSize -> 600,
    Joined -> True,
    LabelingFunction -> None,
    PlotLabels -> Table[
      With[{i = i}, 
       Button[Keys[dt][[i]], 
        pos //= If[MemberQ[pos, i], DeleteCases[i], Append[i]], 
        Appearance -> "Frameless"]],
      {i, length}
      ],
    PlotStyle -> Values[<|black, KeyTake[pos]@color|>],
    PlotLegends -> None
    ]
  ]

ClickPlot[data]

enter image description here

$\endgroup$
5
  • $\begingroup$ This looks promising, thank you. But: I click France - ok. Then I click Portugal - also ok. Now I click Portugal again - Not ok, because all highlights are gone. To continue from this point I have to restart ClickPlot. $\endgroup$
    – eldo
    Aug 17, 2023 at 7:29
  • $\begingroup$ @eldo Should be fixed now $\endgroup$
    – Lukas Lang
    Aug 17, 2023 at 8:28
  • $\begingroup$ Perfect - and much more than I hoped for :) $\endgroup$
    – eldo
    Aug 17, 2023 at 8:35
  • $\begingroup$ @Lukas Lang: Would it possible to hide all the "unselected" plots but keep their PlotLegends on the right so that one can choose from? $\endgroup$ Aug 17, 2023 at 12:53
  • 1
    $\begingroup$ You could replace Black with Opacity[0] $\endgroup$
    – eldo
    Aug 17, 2023 at 16:29
9
$\begingroup$

An alternative way to turn plot labels into Togglers:

ClearAll[togglerLabels]

togglerLabels[Dynamic[y_], vals_, labels_, o : OptionsPattern[]] := 
 Table[With[{i = i}, 
   Setter[Dynamic[MemberQ[y, i], BoxForm`TogglerBarFunction[y, i] &], 
     {True}, labels[[i]], o, Appearance -> None, Alignment -> Center]], 
  {i, vals}]

Example:

blah =.
{togglerLabels[Dynamic[blah], {1, 2, 3}, {"AAA", "BBB", "CCC"}], 
 Dynamic[blah]}

enter image description here

Use togglerLabels[...] as the setting for PlotLabels:

ClearAll[clickPlot]

clickPlot[dt_, o : OptionsPattern[]] := 
 DynamicModule[{pos = {}, lands = Keys @ dt, length = Length @ dt, 
   years = ToExpression @ Keys[dt[[1]]], 
   pal = Flatten[{#, #}] &[ColorData[97, "ColorList"]], black, color},
  color = Table[i -> {pal[[i]], Thickness[0.0025]}, {i, length}];
  black = Table[i -> {Black, Thin}, {i, length}];
  Dynamic @ ListPlot[dt, o,
    DataRange -> MinMax[years],
    FrameTicks -> {{All, None}, {years, None}},
    GridLines -> {years, Automatic},
    PlotLabels -> 
      togglerLabels[Dynamic@pos, Range[length], 
       MapThread[Style[##, 16] &] @ {lands, Values @ color}],
    PlotStyle -> Values[<|black, KeyTake[pos] @ color|>],
    PlotHighlighting -> {"Ball"},Frame -> True, ImageSize -> 600, 
    Joined -> True, PlotLegends -> None, LabelingFunction -> None]]


clickPlot[data]

enter image description here

$\endgroup$
6
  • 1
    $\begingroup$ togglerLabels is essentially TogglerBar with formatting removed to get a list of togglers. $\endgroup$
    – kglr
    Aug 17, 2023 at 11:27
  • 1
    $\begingroup$ PlotHighlighting is introduced in version 13.3.0 $\endgroup$
    – kglr
    Aug 17, 2023 at 14:09
  • 1
    $\begingroup$ I knew I was forgetting a control type that is perfect for this... Very nice! $\endgroup$
    – Lukas Lang
    Aug 17, 2023 at 18:42
  • 1
    $\begingroup$ @kglr: The mean of time-series plots across countries remains unchanged even if we change the number of selected countries. This is because the mean is taken over the entire sample of countries. In fact, it will be more consistent with the plot style if the mean of the selected time-series is calculated. I know this is not what is requested by the question, though. A point to consider for revision. $\endgroup$ Aug 17, 2023 at 19:28
  • 1
    $\begingroup$ very good point. $\endgroup$
    – kglr
    Aug 17, 2023 at 20:15

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.