Non Linear Dynamics

Korteweg-De Vries Equation 
Two Soliton Collision
Som Phene 
 July 26, 2019

KdV[Bval_,x_,t_ J :=Block[{vv,v,w,superpos2,superpos3,
ϕIrr,ϕReg,Solution},
Clear [x,t];

v [xx_,tt_,β_]:=(Sqrt[2β])2 Tanh[ (Sqrt[(β/2)])(xx-2βtt)];
v [xx_,tt_,β_]:=(Sqrt[2β])2 Coth[ (Sqrt[(β/2)])(xx-2βtt)];
superpos2 [xx_,tt_,β1_,β2_]:=((2(β1-β2))/(v[xx, tt, β1]-w[xx, tt, β2]));

ϕIrr[xx_,tt_,β2_,β_ ]:=((2(β2-β))/(v[xx, tt, β2]-v[xx, tt, β]));ϕReg[xx_,tt_,β1_,β_ ]:=((2(β-β1))/(v[xx, tt, β]-w[xx, tt, β1]))

ϕ[1,k_,x_,t_]:=2(k^2)((Sech[k(x-4(k^2) t)])^2)

(*Simplify[(∂_t)ϕ[1,k,x,t]+(∂_(x,x,x))ϕ[1,k,x,t]+6ϕ[1,k,x,t](∂_x) ϕ[1,k,x,t]]*)

(*η[k_,α_,x_,t_]:=k(x-4(k^2) t+α)*)

(*ϕ2[k1_,k2_,α1_,α2_,x_,t_]:=2(∂_(x,x))Log[τ[k1,k2,α1,α2,x,t]]*)

(*Simplify[(∂_t)ϕ2[k1,k2,α1,α2,x,t]+(∂_(x,x,x))ϕ2[k1,k2,α1,α2,x,t]+6ϕ2[k1,k2,α1,α2,x,t](∂_x) ϕ2[k1,k2,α1,α2,x,t]]*)

ϕ[2,k_,x_,t_]:=(8 (E^(-16 (Sqrt[2]) (k^3) t)) (2 (E^(2 (2+(Sqrt[2])) k x))+(17+12 (Sqrt[2])) (E^(2 k ((4+8 (Sqrt[2])) (k^2) t+x)))+(6+4 (Sqrt[2])) (E^(2 k (4 (k^2) t+x+(Sqrt[2]) x)))+(34+24 (Sqrt[2])) (E^(16 (k^3) t+2 (Sqrt[2]) k x))+(E^(2 k (4 (k^2) t+x+2 (Sqrt[2]) (-4 (k^2) t+x))))) (k^2))/((((3-2 (Sqrt[2])) (E^(2 k (-8 (Sqrt[2]) (k^2) t+x+(Sqrt[2]) x)))+(3+2 (Sqrt[2])) ((E^(8 (k^3) t))+(E^(2 k x))+(E^(8 (k^3) t+2 (Sqrt[2]) k (-8 (k^2) t+x))))))^2)

plot[s_,k_,t_]:=Plot[ϕ[s,k,x,t],{x,-50,50},PlotRange->All,Axes->False,PlotStyle->Thick,AspectRatio->.2,ImageSize->{550,200},PlotLabel->Row[{Style[Subscript[ϕ,s],24,Bold],Style[Row[{"(",Style["x",Italic],", ",Style["t",Italic],")"}],24,Bold]}]]

pic[s_,k_,t_]:=Plot3D[ϕ[s,k,x,t],{x,-50,50},{y,0,5},PlotRange->All,Boxed->False,Mesh->False,Axes->False,Ticks->None,PlotPoints->{50,3},MaxRecursion->3,BoxRatios->{10,1,1},ImageSize->{550,200}]

Manipulate[Grid[{{plot[s,k,t]},{pic[s,k,t]}}],{{s,1,"mode"},{1->"1 soliton",2->"2 solitons"},ControlType->SetterBar},{{k,1,"parameter k"},.1,(Sqrt[2]),Appearance->"Labeled"},{{t,-1.5,"time t"},-3,3,.1,Appearance->"Labeled"},SaveDefinitions->True,SynchronousUpdating->False]