(* ::Package:: *)

(* The matrix that generates N-soliton solutions: *)
AA[n_] := Table[KroneckerDelta[i,j] + lambda[i] Exp[-(kappa[i]+kappa[j])x]/(kappa[i]+kappa[j]), {i,n}, {j,n}];


(* The one-soliton solution *)
h1 = (-2 D[Log[Det[AA[1]]], {x,2}] // Simplify) /. {lambda[i_] :> lambda0[i] Exp[8 kappa[i]^3 t]} /. {lambda0[i_] :> 2 kappa[i] Exp[2 kappa[i] x00[i]]} /. {kappa[i_] :> 1/2 Sqrt[v[i]]};


(* The two-solition solution, along with the appropriately shifted one-soliton solutions: *)
Clear[h2, fcn];
h2 = (-2 D[Log[Det[AA[2]]], {x,2}] // Simplify) /. {lambda[i_] :> lambda0[i] Exp[8 kappa[i]^3 t]} /. {lambda0[i_] :> 2 kappa[i] Exp[2 kappa[i] x00[i]]} /. {kappa[i_] :> 1/2 Sqrt[v[i]]} // Simplify;
fcn[x_,t_] = {
	h1,
	h1 /. {x00[1] -> x00[2], v[1] -> v[2]},
	h1 /. {x00[1] -> x00[1] + 1/Sqrt[v[1]] Log[(Sqrt[v[1]]-Sqrt[v[2]])^2/(Sqrt[v[1]]+Sqrt[v[2]])^2]},
	h1 /. {x00[1] -> x00[2], v[1] -> v[2]} /. x00[2] -> x00[2] + 1/Sqrt[v[2]] Log[(Sqrt[v[1]]-Sqrt[v[2]])^2/(Sqrt[v[1]]+Sqrt[v[2]])^2],
	h2
} /. {x00[1] -> 0, x00[2] -> 0, v[1] -> 1, v[2] -> 2} // Simplify;


(* Mathematica's default plot colors *)
Defer[RGBColor] @@@ ColorData[97, "ColorList"] // Column


(* Plot the two-solition scattering: *)
Manipulate[Plot[fcn[x,t] // Evaluate, {x, -50, 50}, PlotRange -> {{-50, 50}, {-1.25,0.03}}, AspectRatio -> 0.33, PlotRange -> All, ImageSize -> {800, 260}, Ticks -> None,
	 PlotStyle -> {{Dashed, Red}, {Dashed, Green // Darker}, {Dotted, Green // Darker}, {Dotted, Red}, {RGBColor[0.3,0.4,0.8], AbsoluteThickness[4]}}], {{t, -20}, -20, 20}, AppearanceElements -> None]


(* Change to notebook's directory, create subdirectory for movie frame images: *)
SetDirectory[NotebookDirectory[]];
DirectoryQ["kdv-movie-data"] || CreateDirectory["kdv-movie-data"]


(* Export video *)
SetSharedVariable[countparallel];
countparallel=0;
Monitor[ParallelTable[
	++countparallel;
	Export[
		"kdv-movie-data/kdv" <> StringPadLeft[ToString[t + 200], 4, "0"] <> ".png",
		Plot[
			fcn[x,t/10] // Evaluate, {x, -50, 50},
			PlotRange -> {{-50, 50}, {-1.25,0.03}}, AspectRatio -> 0.33, PlotRange -> All, ImageSize -> {800, 260}, Ticks -> None, Axes -> False,
			PlotStyle -> {{Dashed, Red}, {Dashed, Green // Darker}, {Dotted, Green // Darker}, {Dotted, Red}, {RGBColor[0.3,0.4,0.8], AbsoluteThickness[4]}}
		]
	],
	{t, -200, 200, 1}, 
	Method -> "CoarsestGrained"
], "Images: " <> ToString[countparallel] <> "/401"]
Run["ffmpeg -f image2 -pattern_type glob -framerate 30 -i 'kdv-movie-data/kdv*.png' -an -c:v libx264 -pix_fmt yuv420p -crf 18 -preset slow -tune animation -r 30 -y kdv.mp4"]
