Уравнения Пенлеве

К лекции 12 (2024)

Галилеевская инвариантность и (Subscript[P, 1])

(1) 	(Subscript[u, t])=(Subscript[u, x x x])-6u (Subscript[u, x])

КдФ допускает решения вида   u(x,t)=2w(z)+2 t, z=x-6 (t^2),  w''=6(w^2)+z

ndsol[w0_,w1_]:=NDSolve[{w''[z]==6((w[z])^2)+z,w[0]==w0,w'[0]==w1,WhenEvent[Abs[w[z]]>10,"StopIntegration"]},w,{z,-35,5}][[1]]

pl[s_]:=Plot[w[z]/.s,{z,-25,s[[1,2,1,1,2]]},
PlotRange->{{-23.5,3.25},{-3.35,4.75}},
PlotStyle->Blue,
AxesLabel->(Style[#,{FontSize->20,FontFamily->"Times New Roman",FontSlant->Italic}]&/@{"z","w"}),
BaseStyle->{FontSize->16,FontFamily->"Times New Roman"},
ImageSize->400
]

Manipulate[s=ndsol[w0,w1];
pl[s],
{{w0,0.9},-3,3,Appearance->"Labeled"},
{{w1,1.7},-3,3,Appearance->"Labeled"}
]

График строится медленно (можно уменьшить PlotPoints)

g=Plot3D[2w[x-6(t^2)]+2t/.s,{x,-15,5},{t,-2,2},
PlotRange->{{-15,5},{-1.7,1.7},{-15,6}},
PlotPoints->250,
Mesh->None,
ClippingStyle->None,
AxesLabel->Evaluate[Style[#,Italic,24]&/@{"x","t","u"}],
ImageSize->600,
BaseStyle->{FontFamily->"Times",FontSize->16}
]

Группа, отвечающая симметри Галилея+сдвиг t

Пояснение, откуда взялась эта редукция. Стационарное уравнение для симметрии: c (6t (Subscript[u, x])-1)+(Subscript[u, t])=0. Решаем его методом характеристик, находим первые интегралы.

Clear[u]

dif[f_]:=6c t D[f,x]+D[f,t]+c D[f,u]
C1=x-3c (t^2);
C2= u-c t;

dif[C1]
dif[C2]
U=c t+F[C1];
Expand[c(6t D[U,x]-1)+D[U,t]]

Уравнения для характеристик фактически совпадают с системой Ли, ее решение с тождественными начальными условиями дает групповое преобразование.

DSolve[{x'[a]==6c t[a],t'[a]==1,u'[a]==c,
x[0]==x0,t[0]==t0,u[0]==u0},
{x[a],t[a],u[a]},a]

По этому решению определяем преобразование и проверяем, что это действительно однопараметрическая группа.

G[a_,{x_,t_,u_}]:={3 (a^2) c+6 a c t+x,t+a,u+a c}
G[0,{x,t,u}]
G[a,G[b,{x,t,u}]]
G[a+b,{x,t,u}]
Expand[%%-%]

Первые интегралы – инварианты группы.

r={x->3 (a^2) c+6 a c t+x,t->t+a,u->u+a c};
C1/.r
Expand[%-C1]
C2/.r
Expand[%-C2]

Скейлинг и (Subscript[P, 2])

КдФ допускает решения вида

u(x,t)=(t^(-2/3))y((t^(-1/3))x),    y'''-6y y'+(1/3)(X y'+2y)=0.

sol2[y0_,y1_,y2_,Mx_]:=NDSolve[{y'''[X]==6y[X]y'[X]-(1/3)(X y'[X]+2y[X]),y[0]==y0,y'[0]==y1,y''[0]==y2,WhenEvent[Abs[y[X]]>100,"StopIntegration"]},y,{X,-Mx,Mx}][[1]]

pl2[s_]:=Plot[y[X]/.s,{X,-35,35},
PlotRange->{{-35,35},{-6.4,2.4}},
PlotStyle->Blue,
AxesLabel->(Style[#,{FontSize->20,FontFamily->"Times New Roman",FontSlant->Italic}]&/@{"X","y"}),
BaseStyle->{FontSize->16,FontFamily->"Times New Roman"},
ImageSize->400]

Manipulate[s=sol2[y0,y1,y2,100];pl2[s],
{{y0,-0.5},-3,3,Appearance->"Labeled"},
{{y1,-0.6},-3,3,Appearance->"Labeled"},
{{y2,-3},-3,3,Appearance->"Labeled"}
]

s=sol2[-0.5,-0.6,-3,125];

g=Plot3D[(t^(-2/3))y[(t^(-1/3))x]/.s,{x,-15,15},{t,0.1,2},
PlotRange->{{-15,15},{0.1,2},{-30,5}},
PlotPoints->300,
Mesh->None,
AxesLabel->Evaluate[Style[#,Italic,24]&/@{"x","t","u"}],
ImageSize->600,
BaseStyle->{FontFamily->"Times",FontSize->16},
ViewPoint->{0,-3,1}
]

Автомодельная подстановка приводит к (Subscript[P, 34]) (с точностью до тривиальных замен)

eqY=-y'''[X]+6y[X]y'[X]-(1/3)X y'[X]-(2/3)y[X]
eqy=Expand[eqY/.{y[X]->y[X]+X/6,y'[X]->y'[X]+1/6}/.y->v]
eqv=-v[X] v''[X]+(1/2)((v'[X])^2)+2 ((v[X])^2)(v[X]+X/6)+с
Expand[eqy v[X]-D[eqv,X]]

Преобразование Миуры к (Subscript[P, 2])

eqy=Expand[eqY/.{y[X]->w'[X]+((w[X])^2),Derivative[n_][y][X]:>D[w'[X]+((w[X])^2),{X,n}]}]
eqw3=-w'''[X]+6((w[X])^2)w'[X]-(1/3)X w'[X]-(1/3)w[X]
Factor[eqy-D[eqw3,X]-2w[X]eqw3]

eqw=-w''[X]+2((w[X])^3)-(1/3)X w[X]+a
eqw3-D[eqw,X]

Сравнение уравнений для v и w

eqv
eqw

Expand[eqv/.{v[X]->w'[X]+((w[X])^2)-X/6,Derivative[n_][v][X]:>D[w'[X]+((w[X])^2)-X/6,{X,n}]}]
Expand[%/.Solve[{eqw,D[eqw,X]}==0,{w''[X],w'''[X]}][[1]]]

sin-Gordon и (Subscript[P, 3])

(Subscript[u, x t])=sin 2u

solu3[u0_,u1_,Mz_]:=NDSolve[{u''[z]==-u'[z]/z+1/z Sin[2u[z]],u[1]==u0,u'[1]==u1,
WhenEvent[Abs[u[z]]>1000,"StopIntegration"]},u,{z,0.0001,Mz}][[1]]

pl3[s_]:=Plot[u[z]/.s,{z,0,100},
PlotRange->{{0,104},{-2.75,5.15}},
PlotStyle->Blue,
AxesLabel->(Style[#,{FontSize->20,FontFamily->"Times New Roman",FontSlant->Italic}]&/@{"z","y"}),
BaseStyle->{FontSize->16,FontFamily->"Times New Roman"},
ImageSize->400]

Manipulate[s=solu3[u0,u1,900];
pl3[s],
{{u0,0.5},-3,3,Appearance->"Labeled"},
{{u1,1},-3,3,Appearance->"Labeled"}]

g=Plot3D[u[x t]/.s,{x,0.01,30},{t,0.01,30},
PlotRange->{{0,30},{0,30},{-5,5.15}},
PlotPoints->300,
Mesh->None,
AxesLabel->Evaluate[Style[#,Italic,24]&/@{"x","t","u"}],
ImageSize->600,
BaseStyle->{FontFamily->"Times",FontSize->16}
]

Регулярное решение. В окрестности 0 строим решение в виде ряда Тейлора, дальше продолжаем NDSolve

Clear[z]

G[u_]=Sin[2u];
Gu[u_]=D[G[u],u];
eps=D[G[u],u,u]/(4 G[u])

(*--- ряд Тейлора по z ---*)
seriesp[v0_,M_]:=Module[{a,g,h,n,j},
a[0]=v0;
g[0]=G[v0];
h[0]=Gu[v0];
Do[a[n]=g[n-1]/(n^2);
g[n]=Sum[k a[k]h[n-k],{k,1,n}]/n; 
h[n]=4eps Sum[k a[k]g[n-k],{k,1,n}]/n,{n,1,M}];
{Sum[a[n](z^n),{n,0,M}],If[a[M]==0,100,((Abs[a[M]])^(-1/M))]}
]

(*--- решение с начальным условием в точке z0≠0 ---*)
solvp[v0_,v1_,zmin_,z0_,zmax_]:=Module[{s,err=If[z0==zmin,zmax,zmin]},
s=NDSolve[{z v''[z]+v'[z]==G[v[z]],
v[z0]==v0,v'[z0]==v1,
WhenEvent[Abs[v[z]]>10,{err=z,"StopIntegration"}]},
v,{z,zmin,zmax}];
{err,s[[1]]}]

(*--- решение с начальным условием в точке z0=0 ---*)
sol0vz[v0_,M_,zmin_,zmax_]:=Module[{V,Vz,r,nsl,nsr},
V=seriesp[v0,M];
r=0.1V[[2]];
V=V[[1]];
Vz=D[V,z];
nsl=solvp[V/.z->-r,Vz/.z->-r,zmin,-r,-r];
nsr=solvp[V/.z->r,Vz/.z->r,r,r,zmax];
Piecewise[{
{v[z]/.nsl[[2]],nsl[[1]]<z≤-r},
{V,-r<z<r},
{v[z]/.nsr[[2]],r≤z<nsr[[1]]}}]
]

L=20;
V=sol0vz[0.3,100,-(L^2),(L^2)];

gv=Plot[Evaluate[V],{z,-(L^2),(L^2)},PlotRange->{{-(L^2),(L^2)}/5,{-0.5,2.4}},PlotStyle->Blue,
AxesLabel->(Style[#,{FontSize->20,FontFamily->"Times New Roman",FontSlant->Italic}]&/@{"z","y"}),
BaseStyle->{FontSize->16,FontFamily->"Times New Roman"},
ImageSize->400]

g=Plot3D[V/.z->x t,{x,-L,L},{t,-L,L},
PlotRange->{{-L,L},{-L,L},{-0.5,2.4}},
PlotPoints->400,
Mesh->None,
AxesLabel->Evaluate[Style[#,Italic,24]&/@{"x","t","u"}],
ImageSize->600,
BaseStyle->{FontFamily->"Times",FontSize->16}
]

Тест Ковалевской-Пенлеве

w''=2(w^3)+z w+α +β z

Делаем замену z-(Subscript[z, 0])=Z

eq=-w''[z]+2((w[z])^3)+(z+z0)(w[z]+β)+α

r=7;
W=p/z+Sum[(z^i)c[i],{i,0,r}]

zz=Collect[eq/.{w''[z]->D[W,z,z],w[z]->W},z,Factor];

Коэффициент p

eqp=Expand[Coefficient[zz,z,-3]]

Уравнение при (z^(-2)) определяет (Subscript[c, 0])

eq0=Factor[Coefficient[zz,z,-2]]
coefs0={c[0]->0,(p^2)->1,(p^3)->p};
Factor[eq0/.coefs0]

Уравнение при (z^(-1)) определяет (Subscript[c, 1])

eq1=Expand[Coefficient[zz,z,-1]]/.coefs0
coefs1=Append[coefs0,c[1]->-p z0/6];
Factor[eq1/.coefs1]

Уравнение при (z^0) определяет (Subscript[c, 2])

eq2=Expand[Coefficient[zz,z,0]]/.coefs1
coefs2=Append[coefs1,c[2]->-(p+α+z0 β)/4];
Factor[eq2/.coefs2]

Уравнение при (z^1): резонанс, (Subscript[c, 3]) не определяется, но появляется ограничение на β

eq3=Expand[Coefficient[zz,z,1]]//.coefs2
coefs3=Append[coefs2,β->0];
Factor[eq3/.coefs3]

Уравнение при (z^2),(z^3) определяет (Subscript[c, 4]),(Subscript[c, 5]) и т.д.

eq4=Expand[Coefficient[zz,z,2]]//.coefs3
eq5=Expand[Coefficient[zz,z,3]]//.coefs3

Можно решать не пошагово, а сразу несколько уравнений

eqp=Collect[Coefficient[zz,z,-3]/2,c[_],Expand]
eq0=Collect[Coefficient[zz,z,-2],c[_],Expand]
eq1=Collect[Coefficient[zz,z,-1],c[_],Expand]
eq2=Collect[Coefficient[zz,z,0],c[_],Expand]

solc=Solve[({eq0,eq1,eq2}/.(p^2)->1)==0,{c[0],c[1],c[2]}][[1]]

eq3=Collect[Coefficient[zz,z,1],c[_],Expand]
eq4=Collect[Coefficient[zz,z,2],c[_],Expand]
eq5=Collect[Coefficient[zz,z,3],c[_],Expand]

Expand[eq3/.solc/.{(p^2)->1,(p^3)->p}]

КдФ. WTC-тест

Ищем решение КдФ в виде ряда Лорана по x-q(t). На первом шаге находим коэффициент при (((x-q))^(-2))

U=Sum[(Subscript[a, s])[t](((x-q[t]))^(s-2)),{s,0,15}]
eq:=Collect[-D[U,t]+D[U,x,x,x]-6U D[U,x]/.x->X+q[t],X,Factor]
cfeq[j_]:=Coefficient[eq/.arule,X,j]

arule={};cfeq[-5]

Следующие несколько уравнений позволяют найти (Subscript[a, 1]),(Subscript[a, 2]),(Subscript[a, 3]). Коэффициент (Subscript[a, 4]) остается свободным.

arule={(Subscript[a, 0])[t]->2};
cfeq[-5]
cfeq[-4]
cfeq[-3]
cfeq[-2]
cfeq[-1]

Далее находим (Subscript[a, 5]),  а (Subscript[a, 6]) также свободен. Остальные находятся однозначно

arule={(Subscript[a, 0])[t]->2,(Subscript[a, 1])[t]->0,(Subscript[a, 2])[t]->(1/6)q'[t],(Subscript[a, 3])[t]->0};
cfeq/@{-5,-4,-3,-2,-1}
cfeq[0]
cfeq[1]
cfeq[2]

arule={(Subscript[a, 0])[t]->2,(Subscript[a, 1])[t]->0,(Subscript[a, 2])[t]->(1/6)q'[t],(Subscript[a, 3])[t]->0,(Subscript[a, 5])[t]->-(1/36)q''[t],(Subscript[a, 7])[t]->(1/24)D[(Subscript[a, 4])[t],t]};

cfeq/@{-5,-4,-3,-2,-1,0,1,2}
cfeq[3]
cfeq[4]
cfeq[5]
Solve[{%%%,%%,%}==0,{(Subscript[a, 8])[t],(Subscript[a, 9])[t],(Subscript[a, 10])[t]}]