Message Boards Message Boards

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

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

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
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract