4

I had this working with Kuba's help some time ago see here but something has changed. I am using version 13.0.

The animation lay out has changed to this configuration where the animation bar is occupying a row with the two graphics also in the row. It should be above the graphics.

enter image description here

Can anyone see what has changed and how to fix it?

The code is as follows.

    Deploy@DynamicModule[{pts, bdr = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}, 
   vals, funs, n = 2, calculate},

Animate[Column[{
     Row[{
       Button["Reset", 
        pts = Table[{6, 6} + 
           3 {Cos[[Theta]], Sin[[Theta]]}, {[Theta], 0, 
           2 [Pi] - 2 [Pi]/10, 2 [Pi]/10}];
        calculate[]],
       "   Mode Number = ", 
       Slider[Dynamic[n, {Automatic, calculate[] &}], {2, 6, 1}, 
        Appearance -> "Labeled"]
       }],


 Row[{
   LocatorPane[Dynamic[pts, {Automatic, calculate[] &}],
    Graphics[{{Dynamic[
        First@ContourPlot[funs[[n]] Cos[t], {x, y} \[Element] bdr,
          Axes -> None, Frame -> None, AspectRatio -> Automatic,

          ColorFunction -> 
           Function[f, {ColorData["TemperatureMap"][f]}],
          PlotPoints -> ControlActive[20, 50]], 
        TrackedSymbols :> {bdr, n, t}]},
      {FaceForm@None, EdgeForm@Thick, Polygon@Dynamic@pts}},
     Frame -> True, PlotRange -> {{0, 12}, {0, 12}}, 
     ImageSize -> 5 72]],

   Dynamic[
    Graphics3D[{GeometricTransformation[
       First@Plot3D[funs[[n]], {x, y} \[Element] bdr,
         Axes -> None, AspectRatio -> Automatic, PlotRange -> All],
       ScalingTransform[{1, 1, Dynamic@Cos[t]}, {6, 6, 0}]]},
     PlotRange -> {{0, 12}, {0, 12}, {-1, 1}},
     BoxRatios -> {1, 1, .5}, ImageSize -> 5 72, 
     ViewPoint -> {-6, -20, 20}]]
   }]

 }],



{t, 0, 2 [Pi]}],


Initialization :> (
    pts = 
     Table[{6, 6} + 3 {Cos[[Theta]], Sin[[Theta]]}, {[Theta], 0, 
       2 [Pi] - 2 [Pi]/10, 2 [Pi]/10}];
    calculate[] := (
      bdr = Polygon@pts;
      {vals, funs} = 
       NDEigensystem[{-Laplacian[u[x, y], {x, y}]}, 
        u[x, y], {x, y} [Element] bdr, 6];
      );


calculate[];
)




]
user21
  • 39,710
  • 8
  • 110
  • 167
Hugh
  • 16,387
  • 3
  • 31
  • 83
  • Try ControlPlacement -> Top in Animate, does it help? – Kuba Oct 25 '22 at 11:19
  • Yes that seems to work. Thanks. All seems to have slowed down. I will look at that. – Hugh Oct 25 '22 at 11:25
  • Yes, in a version I am testing it is unusable. The Countour plot became 40x slower at some point... – Kuba Oct 25 '22 at 11:26
  • For a quick fix add PerformanceGoal -> "Speed" in the ContourPlot but the ux is still worse. – Kuba Oct 25 '22 at 11:37
  • 1
    I suggest reporting this to WRI. Also, since the performance regression (well, is it just performance regression?) is a more serious problem, I suggest adding this to the body of question. – xzczd Oct 25 '22 at 14:16
  • @xzczd Done and WRI confirmed an issue. – Kuba Oct 25 '22 at 19:59
  • @kuba thanks. I use this in lectures each year. This year it was disappointing. Please let me know if it gets resolved. – Hugh Oct 26 '22 at 05:45

2 Answers2

2

Try this:

 Deploy@DynamicModule[{pts, bdr = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}, 
   vals, funs, n = 2, calculate}, Animate[

Grid[{{Button["Reset", 
       pts = Table[{6, 6} + 
          3 {Cos[[Theta]], Sin[[Theta]]}, {[Theta], 0, 
          2 [Pi] - 2 [Pi]/10, 2 [Pi]/10}];
       calculate[]], "Mode Number = ", 
      Slider[Dynamic[n, {Automatic, calculate[] &}], {2, 6, 1}, 
       Appearance -> "Labeled"]},


 {LocatorPane[Dynamic[pts, {Automatic, calculate[] &}], 
   Graphics[{{Dynamic[
       First@ContourPlot[funs[[n]] Cos[t], {x, y} \[Element] bdr, 
         Axes -> None, Frame -> None, AspectRatio -> Automatic, 
         ColorFunction -> 
          Function[f, {ColorData["TemperatureMap"][f]}], 
         PlotPoints -> ControlActive[20, 50]], 
       TrackedSymbols :> {bdr, n, t}]}, {FaceForm@None, 
      EdgeForm@Thick, Polygon@Dynamic@pts}}, Frame -> True, 
    PlotRange -> {{0, 12}, {0, 12}}, ImageSize -> 5 72]], 
  Dynamic[Graphics3D[{GeometricTransformation[
      First@Plot3D[funs[[n]], {x, y} \[Element] bdr, Axes -> None,
         AspectRatio -> Automatic, PlotRange -> All], 
      ScalingTransform[{1, 1, Dynamic@Cos[t]}, {6, 6, 0}]]}, 
    PlotRange -> {{0, 12}, {0, 12}, {-1, 1}}, 
    BoxRatios -> {1, 1, .5}, ImageSize -> 5 72, 
    ViewPoint -> {-6, -20, 20}]], \[SpanFromLeft]}
 }]




, {t, 0, 2 [Pi]}], 
  Initialization :> (pts = 
     Table[{6, 6} + 3 {Cos[[Theta]], Sin[[Theta]]}, {[Theta], 0, 
       2 [Pi] - 2 [Pi]/10, 2 [Pi]/10}];
    calculate[] := (bdr = Polygon@pts;
      {vals, funs} = 
       NDEigensystem[{-Laplacian[u[x, y], {x, y}]}, 
        u[x, y], {x, y} [Element] bdr, 6];);
    calculate[];)]

enter image description here

And make Mma to the full screen. Hope it helps

Alexei Boulbitch
  • 39,397
  • 2
  • 47
  • 96
2

Since I don't know all the settings in the original question, so here only a start point,in order to make the animation faster.( By remove {x, y} ∈ bdr, using Evaluate and decreasing the MaxRecursion and PlotPoints, only use Manipulate etc.)

Manipulate[
 Module[{vals, funs},
  {vals, funs} = 
   NDEigensystem[{-Laplacian[u[x, y], {x, y}], 
     DirichletCondition[u[x, y] == 0, True]}, 
    u[x, y], {x, y} ∈ Polygon@pts, n]; 
  ContourPlot[funs[[n]], {x, 0, 12}, {y, 0, 12}, Axes -> None, 
   AspectRatio -> Automatic, PerformanceGoal -> "Quality", 
   MaxRecursion -> 2, PlotPoints -> 20, PlotRange -> Full, 
   ColorFunction -> Function[f, ColorData["TemperatureMap"][f]], 
   ImageSize -> Medium, BoundaryStyle -> Thick]], {{pts, pts0}, 
  Locator}, 
 Initialization :> {pts0 = CirclePoints[{6, 6}, {3, 2 π/10}, 10], 
   n = 6}]

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133