The sun’s reflection on a wavy sea creates fleeting twinkles—bright spots of light that appear and disappear in pairs as waves shift and tilt the water’s surface. These ephemeral points trace intricate paths, coalescing and annihilating in patterns shaped by the underlying geometry of the moving waves. Some twinkles form closed loops, staying ‘faithful’ to their birth partners, while others drift apart, lost in the randomness of the sea’s motion.
This beautiful interplay between light, motion, and randomness—what Sir Michael Berry called ‘lifelong fidelity’—remains an open question in statistical physics: What fraction of these paired twinkles remain loyal, dying with their original partners? It’s a challenge that blends geometry, physics, and deep mathematical insight.
This beautiful interplay between light, motion, and randomness—what Sir Michael Berry called ‘lifelong fidelity’—remains an open question in statistical physics: What fraction of these paired twinkles remain loyal, dying with their original partners? It’s a challenge that blends geometry, physics, and deep mathematical insight.
Interestingly, this classical dance of light has a quantum parallel. A wave packet evolving within the fractal geometry of a Koch snowflake might exhibit a similar pattern of paths—intertwining, merging, and dispersing—with echoes of ‘lifelong fidelity’ embedded in its quantum statistics. Nature, it seems, enjoys repeating its most elegant patterns across scales. In this computational essay, we explored this idea.
Functions to generate snow flake using Koch curve:
In[]:=
rt[φ_,p0_][line_]:=({{Cos[φ],Sin[φ]},{-Sin[φ],Cos[φ]}}.(#-p0)+p0)&/@linesnowFlake[o_]:=Polygon[(#-{1/2,Sqrt[3]/6})&/@With[{l=KochCurve[o][[1]]},Join[rt[Pi,{1/2,0}][l],rt[-Pi/3,{0,0}][l],rt[Pi/3,{1,0}][l]]]]
In[]:=
colors={RGBColor[0.29,0.70,0.75],RGBColor[0.14,0.55,0.60],RGBColor[0.05,0.43,0.50],RGBColor[0.90,0.90,0.75],RGBColor[0.45,0.75,0.80]};
Visualize the snow flake:
In[]:=
Graphics[regSF5=snowFlake[5],Axes->True]
Out[]=
Numerically solve Schrodinger equation by setting the space increment as δ:
δ=.0001;
In[]:=
Monitor[ndsSF5=NDSolveValue[{ID[psi[x,y,t],t]==-1/2Laplacian[psi[x,y,t],{x,y}],DirichletCondition[psi[x,y,t]==0,True],psi[x,y,0]==Exp[-80(x^2+y^2)]Exp[5Ix]},psi,{t,0,10},{x,y}∈regSF5,Method->{"PDEDiscretization"->{"MethodOfLines","SpatialDiscretization"->{"FiniteElement","MeshOptions"->{"MaxCellMeasure"->δ}}}},EvaluationMonitor:>(monitor=Row[{"t = ",CForm[t]}])];,monitor]monitor
Out[]=
t = 10.
Visualize the wave function at the final time:
In[]:=
Show[Graphics[{FaceForm[],EdgeForm[Black],regSF3}],DensityPlot[Evaluate[Abs[ndsSF5[x,y,9.99]]],{x,y}∈regSF5,PlotPoints100,ColorFunction->(Blend[colors,#]&),PlotRangeAll]]
Out[]=
Create a series of images:
imgSF5=Monitor[Table[DensityPlot[Evaluate[Abs[ndsSF5[x,y,t]]],{x,y}∈regSF5,PlotPoints100,ColorFunction->(Blend[colors,#]&),PlotRangeAll],{t,0,10,.1}],t];
Turn them into GIF:
Export[NotebookDirectory[]<>"SnowFlakeF3-v2.gif",imgSF5]
CITE THIS NOTEBOOK
CITE THIS NOTEBOOK
A quantum fleeting twinkles: wavepacket in fractal region
by Mohammad Bahrami
Wolfram Community, STAFF PICKS, December 31, 2024
https://community.wolfram.com/groups/-/m/t/3348054
by Mohammad Bahrami
Wolfram Community, STAFF PICKS, December 31, 2024
https://community.wolfram.com/groups/-/m/t/3348054