5
$\begingroup$

I want to make a slider with several movable index points (thumbs). I can't find an example where someone has tried this before.

I have started with this module which works on its own.

    ClearAll[multiSlider];
multiSlider::usage = 
  "multiSlider[points,{x1, x2}] Create a slider with as many thumbs \
as points. Range {x1, x2}";
SetAttributes[multiSlider, HoldFirst];
Options[multiSlider] = {ImageSize -> 5 72, AspectRatio -> 1/10};
multiSlider[xx_, {x1_, x2_}, opts : OptionsPattern[]] := 
 DynamicModule[{},
  Column[{
    LocatorPane[
     Dynamic[xx, {xx = #; 
        xx[[All, 2]] = ConstantArray[0, Length[xx]]} &],
     Graphics[{Line[{{x1, 0}, {x2, 0}}]}, 
      FilterRules[{opts, Options[multiSlider]}, Options[ListPlot]]
      ], Appearance -> Table[
       Graphics[{White, Disk[],
         Black, Text[i, {0, 0}],
         Line[{{0, 0.7}, {0, 1}}]},
        ImageSize -> 20],
       {i, Length[xx]}]
     ]
    }]
  ]

This works on its own.

    pos = Transpose[{Range[6], ConstantArray[0, 6]}];
multiSlider[pos, {0.5, 7}]

enter image description here

I am suspicious about using SetAttributes[multiSlider, HoldFirst] but my multiSlider did not work without it.

I then tried to use it in a DynamicModule. First I created a function that I could interact with.

    ClearAll[f];
f[x_, xx_] := Sum[1/Sqrt[(xx[[n]]^2 - x^2)^2 + 0.1], {n, Length@xx}];
SetOptions[Plot, PlotHighlighting -> None];
With[{x1 = 3, x2 = 5},
 xx = Table[x1 + n (x2 - x1)/7, {n, 6}];
 Plot[f[x, xx], {x, x1, x2}, PlotRange -> All,
  Epilog -> {Pink, InfiniteLine[{#, 0}, {0, 1}] & /@ xx},
  AspectRatio -> 1/4, Frame -> True]]

enter image description here

Now for the DynamicModule that should have interaction between my multiSlider and my function.

DynamicModule[{xx, x1 = 3, x2 = 5, is = 8 72},
 xx = Transpose[{Table[x1 + n (x2 - x1)/7., {n, 6}], 
    ConstantArray[0, 6]}];
 Column[{
   Dynamic@Plot[f[x, xx[[All, 1]]], {x, x1, x2}, PlotRange -> All,
     Epilog -> {Pink, InfiniteLine[#, {0, 1}] & /@ xx},
     AspectRatio -> 1/4, Frame -> True, ImageSize -> is],
   multiSlider[xx, {x1, x2}, ImageSize -> is]
       }]
     ]

enter image description here

This does work. There are two changes I need to make.

  1. I have been trying to work with the points being put into the slider being just a list. I can't get this to work. Here is the module where the input is just a list.

     ClearAll[multiSlider];
 multiSlider::usage = 
"multiSlider[points,{x1, x2}] Create a slider with as many thumbs \
as points. Range {x1, x2}";
SetAttributes[multiSlider, HoldFirst];
Options[multiSlider] = {ImageSize -> 5 72, AspectRatio -> 1/10};
multiSlider[xx_, {x1_, x2_}, opts : OptionsPattern[]] := 
DynamicModule[{ss},
ss = Transpose[{xx, ConstantArray[0, Length[xx]]}];
Column[{
 LocatorPane[
  Dynamic[ss, {ss = #; 
     ss[[All, 2]] = ConstantArray[0, Length[ss]]} &],
  Graphics[{Line[{{x1, 0}, {x2, 0}}]}, 
   FilterRules[{opts, Options[multiSlider]}, Options[ListPlot]]
   ], Appearance -> Table[
    Graphics[{White, Disk[],
      Black, Text[i, {0, 0}],
      Line[{{0, 0.7}, {0, 1}}]},
     ImageSize -> 20],
    {i, Length[ss]}]
  ]
 }]
 ]
pos = Range[6];
multiSlider[pos, {0.5, 7}]

enter image description here

The slider seems to work but when added to the module this does not work.

    DynamicModule[{xx, x1 = 3, x2 = 5, is = 8 72},
 xx = Table[x1 + n (x2 - x1)/7., {n, 6}];
 Column[{
   Dynamic@Plot[f[x, xx], {x, x1, x2}, PlotRange -> All,
     Epilog -> {Pink, InfiniteLine[{#, 0}, {0, 1}] & /@ xx},
     AspectRatio -> 1/4, Frame -> True, ImageSize -> is],
   multiSlider[xx, {x1, x2}, ImageSize -> is]
   }]
 ]

enter image description here

  1. I can't add a Dynamic around the input to my slider. This is needed so that other actions may be triggered.

Thanks for any help.

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ Typically, controls are defined with a Dynamic[..] holding the first argument: multiSlider[Dynamic[xx_], {x1_, x2_}, opts : OptionsPattern[]]... -- have you tried that? $\endgroup$ Commented Jun 8 at 20:39
  • $\begingroup$ @MichaelE2 I have been trying that because, as you say, this is the standard form for a Dynamic. However, I can't get it to work. Is there something deeper about a Dynamic or am I along the correct lines. $\endgroup$ Commented Jun 8 at 20:59

2 Answers 2

Reset to default
1
$\begingroup$

There exists a experimental built-in MultiSlider, not documented. It is shortly mentionned by Lou d'Andria's in the Wolfram Technology Conference 2014 (see the companion Notebook of the video). It turns out that this Experimental`MultiSlider accepts the option : Appearance -> "ThumbAppearance" -> ... which can set a individual aspect to each thumb (the idea to try it comes from the fact that IntervalSlider has this option and was coded by Lou d'Andria).

Your code then becomes :

ClearAll[f];
f[x_, xx_] := Sum[1/Sqrt[(xx[[n]]^2 - x^2)^2 + 0.1], {n, Length@xx}];
SetOptions[Plot, PlotHighlighting -> None];
With[{x1 = 3, x2 = 5}, xx = Table[x1 + n (x2 - x1)/7, {n, 6}];
  Plot[f[x, xx], {x, x1, x2}, PlotRange -> All, 
   Epilog -> {Pink, InfiniteLine[{#, 0}, {0, 1}] & /@ xx}, 
   AspectRatio -> 1/4, Frame -> True]];

DynamicModule[{xx, x1 = 3, x2 = 5, is = 8 72}, 
 xx = Table[x1 + n (x2 - x1)/7., {n, 6}];
 Column@{Dynamic@
    Plot[f[x, xx], {x, x1, x2}, PlotRange -> All, 
     Epilog -> {Pink, InfiniteLine[{#, 0}, {0, 1}] & /@ xx}, 
     AspectRatio -> 1/4, Frame -> True, ImageSize -> is]
   , Experimental`MultiSlider[Dynamic[xx], {x1, x2}, ImageSize -> is, 
    Appearance -> 
     "ThumbAppearance" -> (Style[#, FontSize -> 30] & /@ Range[10])]}]

enter image description here

The thumbs are the number 1 to 6. You can move them : it works fine.

Improve this answer
$\endgroup$
2
  • $\begingroup$ I don't understand your text in the question : "I can't add a Dynamic around the input to my slider". I hope that's not a problem. $\endgroup$ Commented Jun 18 at 18:46
  • $\begingroup$ just found a chance to try it. Sorry for the slow response. It is perfect. I would recommend it is moved from experimental to part of the system. Many thanks. $\endgroup$ Commented Jun 27 at 10:56
0
$\begingroup$

You can use Dynamic[pos] to see that your last multiSlider implementation is not working. It needs to receive a held variable created with DynamicModule instead of defining the DynamicModule inside its implementation. This works for me:

ClearAll[multiSlider3];

multiSlider3::usage = "multiSlider3[points,{x1, x2}] Create a slider with as many thumbs as points. Range {x1, x2}";

SetAttributes[multiSlider3, HoldFirst];

Options[multiSlider3] = {ImageSize -> 5 72, AspectRatio -> 1/10};

multiSlider3[ss_, {x1_, x2_}, opts : OptionsPattern[]] :=
  Column @ {
    LocatorPane[
      Dynamic[ss,
        {ss = #;
         ss[[All, 2]] = ConstantArray[0, Length[ss]]}&],
      Graphics[{Line[{{x1, 0}, {x2, 0}}]},
        FilterRules[{opts, Options[multiSlider3]}, Options[ListPlot]]],
      Appearance -> Table[
        Graphics[{White, Disk[], Black, Text[i, {0, 0}], Line[{{0, 0.7}, {0, 1}}]}, ImageSize -> 20],
        {i, Length[ss]}]]}

DynamicModule[
    {xx, x1 = 3, x2 = 5, is = 8 72}
    ,
    xx = Table[{x1 + n (x2 - x1) / 7., 0}, {n, 6}];
    Column @ {
      Dynamic @ Plot[f[x, First /@ xx], {x, x1, x2},
        PlotRange -> All,
        Epilog -> {Pink, InfiniteLine[{#, 0}, {0, 1}]& /@ (First /@ xx)},
        AspectRatio -> 1/4, Frame -> True, ImageSize -> is], 
      multiSlider3[xx, {x1, x2}, ImageSize -> is]}
]
Improve this answer
$\endgroup$
2
  • $\begingroup$ Thanks Gustavo but I can't get it to work. All the thumbs collapse to one location Please could you check what you pasted? Is there a slip.? $\endgroup$ Commented Jun 11 at 21:14
  • $\begingroup$ Weird. It is working for me. What version of WL are you using? I'm using 14.2.1. Maybe puttign an Echo near the ss = # can help you see what is going on. $\endgroup$ Commented Jun 12 at 18:46

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.