Waves in the Great Salt Lake

Using ImageMesh, you can convert image segments into BoundaryMeshRegion objects. These mesh regions allow you to utilize functions across other areas, such as finite element methods (FEM).

To illustrate this FEM connection, determine the major modes of surface waves on the Great Salt Lake in Utah.

In[1]:=

img = EntityValue[Entity["Lake", "GreatSaltLake::yw8cf"], "Image"]

Out[1]=

Regularize the image with a mean-shift filter.

In[2]:=

img2 = MeanShiftFilter[img, 3, 0.1]

Out[2]=

Obtain a segmentation via region growing.

In[3]:=

mask = RegionBinarize[img2, \!\(\* GraphicsBox[ TagBox[RasterBox[CompressedData[" 1:eJzt1jEKwkAQQNFdK0uv4C1sLW0VD6AYxSZCFMRzCJ7XiF3SzFb7lf8ggUCK D8MmM99f1sdJSuk67W/r3X3ZdbvHZtY/bNvr+dQ2h1V7a05Nt9h/Xnv21ytJ kiRJkiRJkn5H7tVuGLMqzqo4q+KsiuNW8bKsimNWfbNwXVbF5Yzuqp0xZFUB dBaui5kF/T5AsxJ1jNAsq0qgs3BlOSPDMrMLmvUBDcNnsbqov2x4FrWrdscA NIu6SjCzoEOEZlGniF5Ta0eMmVXCqjjmCJlV5KzaDWNWxXGreFnMKvAIazeM MUfIXEmtKsCs8hSWsCrOqjhmlSRJkiRJkvS/3tRrD1M= "], {{0, 147}, {150, 0}}, {0, 1}, ColorFunction->GrayLevel], BoxForm`ImageTag["Bit", ColorSpace -> Automatic, Interleaving -> None], Selectable->False], DefaultBaseStyle->"ImageGraphics", ImageSizeRaw->{150, 147}, PlotRange->{{0, 150}, {0, 147}}]\), 1/5]

Out[3]=

Retrieve a BoundaryMeshRegion object of the lake surface.

In[4]:=

\[ScriptCapitalR] = ImageMesh[mask]

Out[4]=

Create a mesh of the lake surface.

In[5]:=

\[CapitalOmega] = TriangulateMesh[\[ScriptCapitalR], MaxCellMeasure -> 8]

Out[5]=

Solve the wave equation of the lake surface by first determining the eigenfunctions of the Laplacian inside the lake region.

In[6]:=

\[ScriptCapitalL] = -\!\( \*SubsuperscriptBox[\(\[Del]\), \({x, y}\), \(2\)]\(\[CurlyPhi][x, y]\)\);

Using boundary condition.

In[7]:=

\[ScriptCapitalB] = DirichletCondition[\[CurlyPhi][x, y] == 0, True];

Generate an orthonormal basis of eigenfunctions Φ with eigenvalues Λ.

In[8]:=

{\[CapitalLambda], \[CapitalPhi]} = NDEigensystem[{\[ScriptCapitalL], \[ScriptCapitalB]}, \[CurlyPhi][x, y], {x, y} \[Element] \[CapitalOmega], 64];

Display the first six oscillation modes.

In[9]:=

GraphicsGrid[ Partition[ Table[ContourPlot[\[CapitalPhi][[ k]], {x, y} \[Element] \[CapitalOmega], PlotRange -> All, PlotLabel -> \[CapitalLambda][[k]], PlotTheme -> "Minimal"], {k, 6}], 3 ], ImageSize -> 512 ]

Out[9]=

The temporal evolution of the decaying oscillation modes is given by the following.

In[10]:=

\[CapitalTheta][\[Lambda]_, \[Xi]_, t_] = FullSimplify[ DSolveValue[Join[{ \!\( \*SubscriptBox[\(\[PartialD]\), \(t, t\)]\(\(TraditionalForm\`\[CurlyTheta]\)[ t]\)\) + \[Xi] \!\( \*SubscriptBox[\(\[PartialD]\), \(t\)]\(\(TraditionalForm\`\ \[CurlyTheta]\)[ t]\)\) == -\[Lambda] \!\(TraditionalForm\`\[CurlyTheta]\)[ t] }, {\!\(TraditionalForm\`\[CurlyTheta]\)[0] == 1, \[CurlyTheta]'[0] == 0} ], \!\(TraditionalForm\`\[CurlyTheta]\)[t], t], {\[Lambda] > 0, \[Xi] > 0, \[Xi]^2 < 4 \[Lambda], t \[Element] Reals} ]

Out[10]=

Expanding an initial perturbation in eigenfunctions and letting these evolve in time, a simulation of wave propagation across the lake is obtained.

In[11]:=

n = 64; weights = Take[GaussianMatrix[{{n}, n/2}], -n - 1]; weights -= Last[weights]; weights = Most[weights]; weights *= 1/First[weights]; wave[t_] = (\[CapitalTheta][\[CapitalLambda], 0.005, t] weights (\[CapitalPhi] /. {x -> 50, y -> 60} )) . \[CapitalPhi]; waveColors = (Blend[{{-0.01, Purple}, {-0.005, Blue}, {0., Green}, {0.005, Orange}, {0.01, Yellow}}, #] &); anim = Table[ ContourPlot[ wave[t], {x, y} \[Element] \[CapitalOmega], PlotRange -> {-0.01, 0.012}, Contours -> Range[-0.01, 0.012, 0.0005], PlotTheme -> "Minimal", ColorFunctionScaling -> False, ContourStyle -> None, ColorFunction -> waveColors ], {t, 0, 255, 1} ]; ListAnimate[anim]

Play Animation

Stop Animation