# Optimize parameters for differential equations

I have differential equations f11, f12, f21, and f22 with respect to t with parameters A and B. I've defined and solved these equations using NDSolve in Mathematica as follows:

A = 2;
B = 6;
NDSolve[
{f11'[t] == -(1/2) I A f12[t] + 1/2 I A f21[t],
f12'[t] == -(1/2) I A f11[t] - I B f12[t] + 1/2 I A f22[t],
f21'[t] == 1/2 I A f11[t] + I B f21[t] - 1/2 I A f22[t],
f22'[t] == 1/2 I A f12[t] - 1/2 I A f21[t],
f22 == 0,f11 == 1, f12 == 0, f21 == 0},
{f11[t], f12[t], f21[t], f22[t]}, {t, 0, 1}]


Plotting the solution for f22[t] produces a graph : I want to adjust the parameters A and B to maximize the value of f22[t]. I just want the maximum value that f22[t] can achieve in any t. In this example, there will be several solutions available, I am interested in understand how I can approach the problem in Mathematica using this example.

Can you advise how to optimize A, B (and t) to achieve this maximum? I'm open to using numerical optimization methods or machine learning algorithms if necessary. Any guidance would be much appreciated.

You could use ParametricNDSolve with A and B as parameters and then use NArgMax. I use the range of t=0 to 1 for my range for ParametricNDSolve and NArgMax and I don't specify any restrictions on the domain of A and B

tMin = 0;
tMax = 1;
soln = f22[t] /.
ParametricNDSolve[{f11'[t] == -(1/2) I A f12[t] + 1/2 I A f21[t],
f12'[t] == -(1/2) I A f11[t] - I B f12[t] + 1/2 I A f22[t],
f21'[t] == 1/2 I A f11[t] + I B f21[t] - 1/2 I A f22[t],
f22'[t] == 1/2 I A f12[t] - 1/2 I A f21[t], f22 == 0,
f11 == 1, f12 == 0, f21 == 0}, {f22[t]}, {t, tMin,
tMax}, {A, B}]
NArgMax[{soln[A, B], tMin < t < tMax}, {A, B, t}]
(*{3.62302, 2.92786*10^-7, 0.867124}*)

• Thank you so much! Jun 20 at 18:43
Clear["Global*"]

eqns = {f11'[t] == -(1/2) I A f12[t] + 1/2 I A f21[t],
f12'[t] == -(1/2) I A f11[t] - I B f12[t] + 1/2 I A f22[t],
f21'[t] == 1/2 I A f11[t] + I B f21[t] - 1/2 I A f22[t],
f22'[t] == 1/2 I A f12[t] - 1/2 I A f21[t], f22 == 0, f11 == 1,
f12 == 0, f21 == 0};


The equations can be solved exactly with DSolve for arbitrary A and B

sol = DSolve[eqns, {f11, f12, f21, f22}, t] Verifying the solutions,

eqns /. sol[] // Simplify

(* {True, True, True, True, True, True, True, True} *)

funcs = {f11[t], f12[t], f21[t], f22[t]} /. sol[] // FullSimplify

(* {(A^2 + 2 B^2 + A^2 Cos[Sqrt[A^2 + B^2] t])/(
2 (A^2 + B^2)), -((
A (B - B Cos[Sqrt[A^2 + B^2] t] +
I Sqrt[A^2 + B^2] Sin[Sqrt[A^2 + B^2] t]))/(2 (A^2 + B^2))), (
A (-B + B Cos[Sqrt[A^2 + B^2] t] +
I Sqrt[A^2 + B^2] Sin[Sqrt[A^2 + B^2] t]))/(2 (A^2 + B^2)), (
A^2 Sin[1/2 Sqrt[A^2 + B^2] t]^2)/(A^2 + B^2)} *)

funcs[] // InputForm

(* (A^2*Sin[(Sqrt[A^2 + B^2]*t)/2]^2)/(A^2 + B^2) *)


For simplicity, assume that A and B are positive. Then to restrict the argument of the Sin to the interval {0, Pi}

Assuming[A > 0 && B > 0,
Reduce[{0 <= (Sqrt[A^2 + B^2]*t)/2 <= Pi, A > 0, B > 0}, t, Reals] //
Simplify]

(* 0 <= t <= (2 π)/Sqrt[A^2 + B^2] *)

{max, arg} = (NMaximize[
{funcs[], 0 <= t <= 2 Pi /Sqrt[A^2 + B^2], A > 0, B > 0},
{t, A, B}, WorkingPrecision -> 15] // Rationalize[#, 0] &) /.
r_Rational :> N[r]

(* {1, {t -> 1.82578, A -> 1.72068, B -> 0}} *)

funcs[] /. arg

(* 1. *)
`
• Thank you so much. This definitely work, but for my application, I have actually much more complicated system, so I want to approach with numerical method. However, thank you so much! Jun 20 at 18:40