1

In[]:=
Clear[f]​​f[k_,c_]:=f[k,c]=k*Sin[k]+c*Cos[k]
In[]:=
fim[c_,xm_,xp_,ym_,yp_]:=ContourPlot[Im[f[k1+I*k2,c]],{k1,xm,xp},{k2,ym,yp},Contours{0},ContourStyle{Black,Dashed},ContourShadingNone,PlotPoints100,PerformanceGoal"Speed",AspectRatio(yp-ym)/(xp-xm),AxesTrue]
In[]:=
fre[c_,xm_,xp_,ym_,yp_]:=ContourPlot[Re[f[k1+I*k2,c]],{k1,xm,xp},{k2,ym,yp},Contours{0},ContourStyleBlack,ContourShadingNone,PlotPoints100,PerformanceGoal"Speed",AspectRatio(yp-ym)/(xp-xm),AxesTrue]
In[]:=
fpic[c_,xm_,xp_,ym_,yp_]:=Show[fim[c,xm,xp,ym,yp],fre[c,xm,xp,ym,yp],AxesTrue]
In[]:=
fphasepic[c_,xm_,xp_,ym_,yp_]:=DensityPlot[Arg[f[k1+I*k2,c]],{k1,xm,xp},{k2,ym,yp},ColorFunctionHue,PlotPoints100,PerformanceGoal"Speed",AspectRatio(yp-ym)/(xp-xm),AxesTrue]
In[]:=
fpic[.5+6*I,-10,10,-2.5,2.5]
In[]:=
fphasepic[.5+6*I,-10,10,-2.5,2.5]

2

In[]:=
Clear[klarge]
In[]:=
klarge[m_,c_]:=klarge[m,c]=(m+1/2)*Pi*(1+1/(c))
In[]:=
largepoints[c_,mm_]:=Graphics[{Red,PointSize[.02],Table[Point[{Re[klarge[m,c]],Im[klarge[m,c]]}],{m,0,mm}]}]
In[]:=
(*smallc*)​​Clear[ksmall]​​ksmall[m_,c_]:=ksmall[m,c]=m*Pi-c/m/Pi
In[]:=
smallpoints[c_,mm_]:=Graphics[{Blue,PointSize[.02],Table[Point[{Re[ksmall[m,c]],Im[ksmall[m,c]]}],{m,1,mm}]}]
In[]:=
(*largeIm[c]>0*)​​Clear[krogue]​​krogue[c_]:=krogue[c]=-I*c
In[]:=
roguepoint[c_]:=Graphics[{Black,PointSize[.02],Point[{Re[krogue[c]],Im[krogue[c]]}]}]​​Show[fpic[5+6*I,-2,20,-6,6],roguepoint[5+6*I],largepoints[5+6*I,6],AxesTrue]
In[]:=
Show[fpic[.3+.1*I,-5,40,-5,5],smallpoints[.3+.1*I,6]]
In[]:=
Show[fpic[5+6*I,-2,20,-6,6],roguepoint[5+6*I],largepoints[5+6*I,6],smallpoints[5+6*I,6]]
In[]:=
Show[fpic[10+30*I,-2,30,-6,2],roguepoint[10+30*I],largepoints[10+30*I,20],smallpoints[10+12*I,30],AxesTrue]
In[]:=
Show[fpic[5+10*I,-1,30,-6,2],roguepoint[5+10*I],largepoints[5+10*I,20],smallpoints[5+10*I,30],AxesTrue,AxesOrigin{0,0}]
In[]:=
largepoints1[c_,mm_]:=Graphics[{Red,PointSize[.02],Table[Point[{Re[klarge[m,c]],Im[klarge[m,c]]}],{m,0,Floor[Abs[c]/Pi]}]}]
In[]:=
smallpoints1[c_,mm_]:=Graphics[{Blue,PointSize[.02],Table[Point[{Re[ksmall[m,c]],Im[ksmall[m,c]]}],{m,Floor[Abs[c]/Pi]+1,mm}]}]
In[]:=
Show[fpic[5+10*I,-1,30,-6,2],roguepoint[5+10*I],largepoints1[5+10*I,20],smallpoints1[5+10*I,30],AxesTrue,AxesOrigin{0,0}]
In[]:=
Show[fpic[5,-1,30,-6,2],roguepoint[5],largepoints1[5,20],smallpoints1[5,30],AxesTrue,AxesOrigin{0,0}]

3

In[]:=
Clear[knum]
In[]:=
knum[n_,c_]:=knum[n,c]=If[n0,k/.FindRoot[f[k,c]0,{k,krogue[c]}],If[n<Abs[c]/Pi,k/.FindRoot[f[k,c]0,{k,klarge[n-1,c]}],k/.FindRoot[f[k,c]0,{k,ksmall[n,c]}]]]
In[]:=
knumpoints[c_,nn_]:=Graphics[{Red,PointSize[.02],Table[Point[{Re[knum[m,c]],Im[knum[m,c]]}],{m,0,nn}]}]
In[]:=
complexCpic=Show[fpic[5+10*I,-1,30,-6,2],knumpoints[5+10*I,30],AxesTrue,AxesOrigin{0,0}]
In[]:=
Clear[tt]​​tt[c_,nn_]:=tt[c,nn]=Table[knum[n,c],{n,0,nn}];Clear[kk]​​kk[m_,c_]:=kk[m,c]=tt[c,400]〚m+1〛
In[]:=
Clear[cc,psi]​​cc[n_,c_,ll_,q_]:=cc[n,c,ll,q]=ll*Sqrt[2*Pi]/(1+Sin[2*kk[n,c]]/2/kk[n,c])*(Exp[-ll^2*(kk[n,c]-q)^2/2]+Exp[-ll^2*(kk[n,c]+q)^2/2])
In[]:=
psi[x_,t_,c_,ll_,q_]:=psi[x,t,c,ll,q]=Sum[N[cc[n,c,ll,q]*Cos[kk[n,c]*Abs[x]]*Exp[-I*kk[n,c]^2*t]],{n,0,2*Floor[3/Pi/ll]}]
In[]:=
carpet1[c_,ll_,q_]:=DensityPlot[Abs[psi[x,t,c,ll,q]],{x,-1,1},{t,0,1/Pi},PlotPoints200,ColorFunction(Hue[(1-#)^2,Sqrt[#],#^(.75)]&),PerformanceGoal"Speed",PlotRangeAll]​​carpet1a[c_,ll_,q_]:=DensityPlot[Abs[psi[x,t,c,ll,q]],{x,-1,1},{t,0,1/Pi},PlotPoints200,ColorFunction(Hue[(1-#)^2,Sqrt[#],3*#]&),PerformanceGoal"Speed",PlotRangeAll]​​c1=carpet1[5,.1,20]
In[]:=
c1a=carpet1a[5,.1,20]
In[]:=
fig3a=Show[c1a,FrameTicksNone]
In[]:=
c2=carpet1[5+3*I,.1,20]
In[]:=
c2a=carpet1a[5+3*I,.1,20]
In[]:=
fig3b=Show[c2a,FrameTicksNone]