Group Abstract Group Abstract

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