Message Boards Message Boards

[GIF] Good Vibrations (Chladni patterns on the disk)

GROUPS:

Chladni patterns on the disk

Good Vibrations

In the same spirit as The Band Plays On, here are Chladni patterns (which is to say: the nodal lines) for a family of vibration modes on the disk interpolating between the $(2,3)$ mode and the $(3,2)$ mode. ContourPlot is pretty slow for this, so rather than an unresponsive Manipulate, here's the code for generating the GIF:

BesselZeros = N@Table[BesselJZero[m, n], {m, 0, 5}, {n, 1, 5}];

λ[m_, n_] := BesselZeros[[m + 1, n]];

u[m_, n_, r_, θ_, t_, c_, A_, B_, C_, D_] 
   := (A Cos[c λ[m, n] t] + B Sin[c λ[m, n] t]) 
     BesselJ[m, λ[m, n] r] (C Cos[m θ] + D Sin[m θ]);

diskChladni = With[
   {m = 1,
    n = 2,
    c = 1,
    cols = RGBColor /@ {"#D7F2F7", "#354D62"}},
   ParallelTable[
      Show[
       Graphics[{Thickness[.005], cols[[1]], Circle[]}],
       ContourPlot[ 
        Cos[t] u[2, 3, Norm[{-y, x}], ArcTan[-y, x], 0, c, 1/2, 0, 1/2, 0]
          + Sin[t] u[3, 2, Norm[{-y, x}], ArcTan[-y, x], 0, c, 1/2, 0, 1/2, 0] == 0,
        {x, -1, 1}, {y, -1, 1}, PlotPoints -> 100, 
        ContourStyle -> Directive[Thickness[.005], cols[[1]]], 
        RegionFunction -> Function[{x, y, z}, x^2 + y^2 < .99]],
       Background -> cols[[-1]], PlotRange -> Sqrt[2], 
       ImageSize -> 540],
      {t, 0., π - #, #}] &[π/200]
   ];

Export[NotebookDirectory[] <> "diskChladni.gif", diskChladni, "DisplayDurations" -> {3/100}]
POSTED BY: Clayton Shonkwiler
Answer
1 year ago

enter image description here - another post of yours has been selected for the Staff Picks group, congratulations !

We are happy to see you at the top of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!

POSTED BY: Moderation Team
Answer
1 year ago

Group Abstract Group Abstract