10
$\begingroup$

I have written the following DynamicModule. The idea is that you can change the boundary, calculate the eigenfunctions and then animate them. Here is the code:

DynamicModule[{pts, bdr = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}, vals, 
  funs, n = 2, ar = False},
 pts = Table[{6, 6} + 3 {Cos[θ], Sin[θ]}, {θ, 0, 
    2 π - 2 π/10, 2 π/10}];
 bdr = BoundaryDiscretizeGraphics[Line[Join[pts, {pts[[1]]}]]];
 {vals, funs} = 
  NDEigensystem[{-Laplacian[u[x, y], {x, y}]}, 
   u[x, y], {x, y} ∈ bdr, 6];
 ar = False;
 Column[{
   Row[{
     Button["Calculate",
      bdr = BoundaryDiscretizeGraphics[Line[Join[pts, {pts[[1]]}]]];
      {vals, funs} = 
       NDEigensystem[{-Laplacian[u[x, y], {x, y}]}, 
        u[x, y], {x, y} ∈ bdr, 6]
      , ImageSize -> 1 72],
     Spacer[18],
     "Mode Number = ",
     Slider[Dynamic[n], {2, 6, 1}, Appearance -> "Labeled"],
     Spacer[18],
     Button["Toggle Animate", If[ar, ar = False, ar = True], 
      ImageSize -> 2 72]
     }],
   LocatorPane[Dynamic[pts],
    Dynamic@Animate[Show[
       Graphics[{Line[Join[pts, {pts[[1]]}]]}, Frame -> True, 
        PlotRange -> {{0, 12}, {0, 12}}, ImageSize -> 10 72],
       ContourPlot[funs[[n]] Cos[t], {x, y} ∈ bdr, 
        Axes -> None, Frame -> None, AspectRatio -> Automatic, 
        ColorFunction -> 
         Function[f, {Opacity[0.75], ColorData["TemperatureMap"][f]}]]
       ],
      {t, 0, 2 π}, AnimationRunning -> ar]
    ]
   }]
 ]

Mathematica graphics

This is mostly working. The problem is you cannot use the animation slider If you set up a boundary, calculate and then try and use it you get this

Mathematica graphics

The locator has jumped to the animation slider controls. As a workaround I added the Toggle Animate button. This seems to work sometimes but not always. I am not clear what is wrong. How can I animate when requested.

The version is 11.2.0 for Microsoft Windows (64-bit) (September 11, 2017)

Thanks for any help.

Edit

A minor point raised by Kuba. I am simulating an acoustic cavity. For this case the potential function is equivalent to the acoustic pressure while the gradient is equivalent to the acoustic particle velocity. Thus for the boundary conditions I have no Dirichlet boundary condition and use the fact that Mathematica assumes zero Neumann boundary conditions to make the acoustic velocity zero at the boundaries. To have, for example, a membrane simulation add the Dirichlet condition.

$\endgroup$
3
  • $\begingroup$ Maybe the title of the question is somewhat misleading. Still a cool app. You can use DynamicModule instead. There, you would have to wrap dymanic variables with Dynamic. The advantage is that Dynamic has a second, optional argument that lets you control when and how a change of the dynamic variable takes effect in the body of DynamicModule. $\endgroup$ – Henrik Schumacher Oct 23 '17 at 10:25
  • $\begingroup$ @HenrikSchumacher This is a DynamicModule. Are you suggesting a DynamicModule within a DynamicModule? I am familiar with using the second argument of Dynamic so I am not sure what you are suggesting. $\endgroup$ – Hugh Oct 23 '17 at 10:56
  • $\begingroup$ I think, I was suggesting to use a single DynamicModule instead of Animate. But you know, these dynamic programming things cause headaches to me... Anyways, Kuba seems to have it solved for you. $\endgroup$ – Henrik Schumacher Oct 23 '17 at 11:09
10
$\begingroup$

The fix is to move Animate outside of LocatorPane, but let's go couple of steps further:

  • I turned Eigenvalues procedure into a function calculate[] to prevent code duplication

  • The second argument of Dynamic in Slider and LocatorPane is used to neatly invoke calculate[]

  • 'Nested Dynamic' and 'combining dynamic plots without Show ' tricks are used, read more in 148412

  • Plot3D is added with a neat ScalingTransform trick which spares Plot3D recalculation if only t changes.

enter image description here

And a variation with DirichletCondition[u[x, y] == 0, True]:

enter image description here

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

  Animate[
   Column[{
     Row[{
       "Mode Number = ", 
       Slider[Dynamic[n, {Automatic, calculate[] &}], {2, 6, 1}, 
        Appearance -> "Labeled"], Spacer[18],
       Button["Toggle Animate", If[ar, ar = False, ar = True], 
        ImageSize -> 2 72]
       }],
     Grid[{{
        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 -> 500, 
          ViewPoint -> {-6, -20, 20}]]
        }}]
     }]
   , {t, 0, 2 \[Pi]}, AnimationRunning -> ar]
  ,
  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[];
    )
  ]
$\endgroup$
5
  • $\begingroup$ Kuba thanks. A point that interested me was the quality of the Graphics3D. If the shape is changed while the animation is in progress then there is a poor quality plot (e.g. no mesh). However, if the animation is stopped and then a change made after a moment the quality plot appears and is maintained when the animation is started however fast it it run. I often have problems with poor quality animation because I get the poor quality image all the time not the high quality one. $\endgroup$ – Hugh Oct 23 '17 at 13:45
  • $\begingroup$ @Hugh see PerformanceGoal, notice that during t animation the plot is smooth because I don't generate a plot3d's mesh again but just manipulate GeometricTransform parameter. $\endgroup$ – Kuba Oct 23 '17 at 14:18
  • $\begingroup$ I have just been looking upGeometricTransform and examining your trick of using this to get the animation. I also notice that you have a Dynamic within a Dynamic. I guess Mathematica knows when to update each -something I am very unclear on; is there a tutorial on this?. Thanks for your help $\endgroup$ – Hugh Oct 23 '17 at 15:23
  • $\begingroup$ @Hugh please see my edit and let me know if anything more should be commented on $\endgroup$ – Kuba Oct 23 '17 at 20:20
  • $\begingroup$ Thanks for your efforts. We can remove The Button["Toggle Animate"... which did not work for me and does not work now. The Animation controls now work for this function. Thus also remove the AnimationRunning. Other usages that were new to me were Automatic in the DynamicModule (avoids n=#) , ControlActive (which is along the lines of PerformanceGoal and the use of TrackedSymbols within a Dynamic (I have only used this in a DynamicModule). $\endgroup$ – Hugh Oct 23 '17 at 21:09

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.