How to make a LocatorPane Appearance option dynamic?

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]}]

With a change in the polynomial order I get

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

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]}]
    }] ]
 ]