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.

Improve this question
$\endgroup$
1

2 Answers 2

Reset to default
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

Improve this answer
$\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$ Commented Aug 17, 2023 at 7:29
  • $\begingroup$ @eldo Should be fixed now $\endgroup$ Commented Aug 17, 2023 at 8:28
  • $\begingroup$ Perfect - and much more than I hoped for :) $\endgroup$ Commented 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$ Commented Aug 17, 2023 at 12:53
  • 1
    $\begingroup$ You could replace Black with Opacity[0] $\endgroup$ Commented 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

Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ togglerLabels is essentially TogglerBar with formatting removed to get a list of togglers. $\endgroup$ Commented Aug 17, 2023 at 11:27
  • 1
    $\begingroup$ PlotHighlighting is introduced in version 13.3.0 $\endgroup$ Commented Aug 17, 2023 at 14:09
  • 1
    $\begingroup$ I knew I was forgetting a control type that is perfect for this... Very nice! $\endgroup$ Commented 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$ Commented Aug 17, 2023 at 19:28
  • 1
    $\begingroup$ very good point. $\endgroup$ Commented Aug 17, 2023 at 20:15

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.