3
$\begingroup$

I have a DynamicModule that contains a LocatorPane. The number of locators can be changed. The locators are labelled with a number. When the number of locators are changed the label numbers should also change. However, this does not happen. I think it is because the Appearance option for the locators is generated when the LocatorPane is first set up and is not changed subsequently. I have tried putting a Dynamic in various places but this does not work.

The DynamicModule enables the coefficients of a polynomial to be modified and looks at how the roots move around as a consequence. The second box is the LocatorPain with labelled coefficients. The subscript should change as the polynomial order changes.

ClearAll[appearanceA];
appearanceA[pts_] :=
  Table[Graphics[
    Text[Style[Subscript[a, i - 1], FontFamily -> Times, 
      FontSize -> 24], pts[[i]], {1, -1.2}]], {i, Length@pts}];

DynamicModule[{n = 3, apts = {{1, 0}, {2, 0}, {3, 0}}, roots, s},
 apts = Transpose[{apts[[All, 1]], ConstantArray[0, n]}];
 roots = s /. 
   NSolve[Sum[apts[[i, 1]] s^(i - 1), {i, n}] + s^n == 0, s];
 
 (* Graphics for polynomial coefficients *)
 Column[{
   Framed@
    Row[{ "Polynomial Order =" , 
      InputField[Dynamic[n, {n = #; apts = Table[{i, 0}, {i, n}];
          
          roots = s /. 
            NSolve[Sum[apts[[i, 1]] s^(i - 1), {i, n}] + s^n == 0, s]
          } &], ImageSize -> 0.5 72] }],
   Framed@
    LocatorPane[
     Dynamic[apts, {apts = #; 
        apts = Transpose[{apts[[All, 1]], ConstantArray[0, n]}];
        roots = 
         s /. NSolve[Sum[apts[[i, 1]] s^(i - 1), {i, n}] + s^n == 0, 
           s]} &],
     Dynamic[
      Graphics[{Blue, PointSize[0.02], Point[apts]}, 
       Axes -> { True, False}, AspectRatio -> 1/8, 
       PlotRange -> {{-10, 10}, {-0.1, 0.1}}, ImageSize -> 6 72, 
       BaseStyle -> {FontFamily -> Times, FontSize -> 24}]
      ],
     Appearance -> appearanceA[apts]
     ],
   
   (* Graphics for roots *)
   Framed@
    Dynamic[Graphics[{Red, PointSize[0.02], Point[ReIm[roots]]}, 
      Axes -> True, ImageSize -> 6 72, 
      PlotRange -> {{-10, 10}, {-10, 10}},
      AxesLabel -> {"Real", "Imaginary"}, 
      BaseStyle -> {FontFamily -> Times, FontSize -> 24}]],
   Row[{"Roots = ", Dynamic[roots]}]

Initial set up

With a change in the polynomial order I get

Changed polynomial order

So the last Appearance item has just been repeated. How can I get the correct label for each locator?

$\endgroup$
2
  • 1
    $\begingroup$ use Appearance ->appearanceA[Table[{i, 0}, {i, 50}]]? $\endgroup$ – kglr Sep 22 '20 at 3:25
  • $\begingroup$ @kglr An excellent work around. Thank you. I guess there is no proper solution. $\endgroup$ – Hugh Sep 22 '20 at 6:48
1
$\begingroup$

Your code misses some brackets and braces at the end. Then you need "Dynamic" around code. Here is the cleaned up working code:

ClearAll[appearanceA];
appearanceA[
   pts_] := (Table[
    Graphics[
     Text[Style[Subscript["a", i - 1], FontFamily -> Times, 
       FontSize -> 24], pts[[i]], {1, -1.2}]], {i, Length@pts}]);

DynamicModule[{n = 3, apts = {{1, 0}, {2, 0}, {3, 0}}, roots, s}, 
 apts = Transpose[{apts[[All, 1]], ConstantArray[0, n]}];
 roots = s /. 
   NSolve[Sum[apts[[i, 1]] s^(i - 1), {i, n}] + s^n == 0, s];
 (*Graphics for polynomial coefficients*)Dynamic[Column[{
    Framed@
     Row[{"Polynomial Order =", 
       InputField[Dynamic[n, {n = #; apts = Table[{i, 0}, {i, n}];
           
           roots = 
            s /. NSolve[
              Sum[apts[[i, 1]] s^(i - 1), {i, n}] + s^n == 0, s]} &], 
        ImageSize -> 0.5 72]}],
    Framed@LocatorPane[Dynamic[apts, {apts = #;
         apts = Transpose[{apts[[All, 1]], ConstantArray[0, n]}];
         roots = 
          s /. NSolve[Sum[apts[[i, 1]] s^(i - 1), {i, n}] + s^n == 0, 
            s]} &], 
      Dynamic[Graphics[{Blue, PointSize[0.02], Point[apts]}, 
        Axes -> {True, False}, AspectRatio -> 1/8, 
        PlotRange -> {{-10, 10}, {-0.1, 0.1}}, ImageSize -> 6 72, 
        BaseStyle -> {FontFamily -> Times, FontSize -> 24}]], 
      Appearance -> appearanceA[apts]],(*Graphics for roots*)
    Framed@Dynamic[
      Graphics[{Red, PointSize[0.02], Point[ReIm[roots]]}, 
       Axes -> True, ImageSize -> 6 72, 
       PlotRange -> {{-10, 10}, {-10, 10}}, 
       AxesLabel -> {"Real", "Imaginary"}, 
       BaseStyle -> {FontFamily -> Times, FontSize -> 24}]], 
    Row[{"Roots = ", Dynamic[roots]}]
    }] ]
 ]

enter image description here

$\endgroup$

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.